~dieggsy/srfi-197

e37a6f0004f76c5a3c362560a864583afa084184 — dieggsy 2 years ago 389dda8 0.2.0 
Simplify everything
patch browse .tar.gz 
11 files changed, 755 insertions(+), 917 deletions(-)

D README.org
D README.svnwiki
M srfi-197-impl.scm
D srfi-197-syntax-case.scm
M srfi-197.egg
M srfi-197.release-info
M srfi-197.scm
D srfi-197.sld
A srfi-197.svnwiki
D srfi-64-minimal.scm
M tests/run.scm

D README.org => README.org +0 -233
@@ 1,233 0,0 @@
* 197: Pipeline Operators
** Abstract
Many functional languages provide pipeline operators, like Clojure's -> or OCaml's |>. Pipelines are a simple, terse, and readable way to write deeply-nested expressions. This SRFI defines a family of chain and nest pipeline operators, which can rewrite nested expressions like (a b (c d (e f g))) as a sequence of operations: (chain g (e f _) (c d _) (a b _)).

For more information see: [[https://srfi.schemers.org/srfi-197/][197: Pipeline Operators]]
** Rationale
Deeply-nested expressions are a common problem in all functional languages, especially Lisps. Excessive nesting can result in deep indentation and parenthesis-matching
errors.

#+BEGIN_SRC scheme
; Quick, how many close parentheses are there?
(eta (zeta (epsilon (delta (gamma (beta (alpha)))))))
#+END_SRC

Additionally, some expressions sound more natural when written inside out, as a sequence of steps from start to finish.

#+BEGIN_SRC scheme
; This recipe looks… backwards.
(bake (pour (mix (add eggs (add sugar (add flour bowl))))) (fahrenheit 350))
#+END_SRC

Many functional languages solve this by introducing pipeline operators. This SRFI defines a chain operator inspired by Clojure's threading macros, but with _ as an
argument placeholder, a notation also used in SRFI 156.

#+BEGIN_SRC scheme
(chain (alpha) (beta _) (gamma _) (delta _) (epsilon _) (zeta _) (eta _))

(chain bowl
       (add flour _)
       (add sugar _)
       (add eggs _)
       (mix _)
       (pour _)
       (bake _ (fahrenheit 350)))
#+END_SRC

Pipelines are especially useful for nested list and vector operations.

#+BEGIN_SRC scheme
(chain xs
       (map (lambda (x) (+ x 1) _)
       (filter odd? _)
       (fold * 1 _))
#+END_SRC

Scheme already provides an idiomatic way to chain expressions in let* and SRFI 2 and-let*, but the primary advantage of chain is terseness and the accompanying
readability. This focus on readability and reduced nesting is similar in spirit to SRFI 156 and SRFI 26.

Compared to an equivalent let* expression, chain removes two levels of parenthesis nesting, does not define any intermediate variables, and allows mixing single and
multiple return values.

To demonstrate the difference in verbosity, here is the let* equivalent of the recipe expression:

#+BEGIN_SRC scheme
(let* ((x bowl)
       (x (add flour x))
       (x (add sugar x))
       (x (add eggs x))
       (x (mix x))
       (x (pour x)))
  (bake x (fahrenheit 350)))
#+END_SRC

Like let*, chain guarantees evaluation order. In fact, (chain a (b _) (c _)) expands to something like (let* ((x (b a)) (x (c x))) x), not (c (b a)), and so chain is not suitable for pipelines containing syntax like if or let.

For pipelines containing complex syntax, the nest and nest-reverse operators look like chain but are guaranteed to expand to nested forms, not let* forms. nest nests in
the opposite direction of chain, so (nest (a _) (b _) c) expands to (a (b c)).
** Specification
*** chain
(chain <initial-value> [<placeholder> [<ellipsis>]] <step> ...)
*** Syntax
<initial-value> is an expression.

<placeholder> and <ellipsis> are literal symbols; these are the placeholder symbol and ellipsis symbol. If <placeholder> or <ellipsis> are not present, they default to _ and ..., respectively.

The syntax of <step> is (<datum> ...), where each <datum> is either the placeholder symbol, the ellipsis symbol, or an expression. A <step> must contain at least one
<datum>. The ellipsis symbol is only allowed at the end of a <step>, and it must immediately follow a placeholder symbol.
*** Semantics
chain evaluates each <step> in order from left to right, passing the result of each step to the next.

Each <step> is evaluated as an application, and the return value(s) of that application are passed to the next step as its pipeline values. <initial-value> is the pipeline value of the first step. The return value(s) of chain are the return value(s) of the last step.

The placeholder symbols in each <step> are replaced with that step's pipeline values, in the order they appear. It is an error if the number of placeholders for a step does not equal the number of pipeline values for that step, unless the step contains no placeholders, in which case it will ignore its pipeline values.

#+BEGIN_SRC scheme
(chain x (a b _)) ; => (a b x)
(chain (a b) (c _ d) (e f _)) ; => (let* ((x (a b)) (x (c x d))) (e f x))
(chain (a) (b _ _) (c _)) ; => (let*-values (((x1 x2) (a)) ((x) (b x1 x2))) (c x))
#+END_SRC

If a <step> ends with a placeholder symbol followed by an ellipsis symbol, that placeholder sequence is replaced with all remaining pipeline values that do not have a matching placeholder.

#+BEGIN_SRC scheme
(chain (a) (b _ c _ ...) (d _))
; => (let*-values (((x1 . x2) (a)) ((x) (apply b x1 c x2))) (d x))
#+END_SRC

chain and all other SRFI 197 macros support custom placeholder symbols, which can help to preserve hygiene when used in the body of a syntax definition that may insert a _ or ....

#+BEGIN_SRC scheme
(chain (a b) <> (c <> d) (e f <>))
 ; => (let* ((x (a b)) (x (c x d))) (e f x))
(chain (a) - --- (b - c - ---) (d -))
; => (let*-values (((x1 . x2) (a)) ((x) (apply b x1 c x2))) (d x))
#+END_SRC
*** chain-and
(chain-and <initial-value> [<placeholder>] <step> ...)
**** Syntax
<initial-value> is an expression.

<placeholder> is a literal symbol; this is the placeholder symbol. If <placeholder> is not present, the placeholder symbol is _.

The syntax of <step> is (<datum> ... [<_> <datum> ...]), where <_> is the placeholder symbol.
**** Semantics
A variant of chain that short-circuits and returns #f if any step returns #f. chain-and is to chain as SRFI 2 and-let* is to let*.

Each <step> is evaluated as an application. If the step evaluates to #f, the remaining steps are not evaluated, and chain-and returns #f. Otherwise, the return value of the step is passed to the next step as its pipeline value. <initial-value> is the pipeline value of the first step. If no step evaluates to #f, the return value of chain-and is the return value of the last step.

The <_> placeholder in each <step> is replaced with that step's pipeline value. If a <step> does not contain <_>, it will ignore its pipeline value, but chain-and will still check whether that pipeline value is #f.

Because chain-and checks the return value of each step, it does not support steps with multiple return values. It is an error if a step returns more than one value.
*** chain-when
(chain-when <initial-value> [<placeholder>] ([<guard>] <step>) ...)
**** Syntax
<initial-value> and <guard> are expressions. <placeholder> is a literal symbol; this is the placeholder symbol. If <placeholder> is not present, the placeholder symbol is _. The syntax of <step> is (<datum> ... [<_> <datum> ...]), where <_> is the placeholder symbol.
**** Semantics
A variant of chain in which each step has a guard expression and will be skipped if the guard expression evaluates to #f.
**** Example
#+BEGIN_SRC scheme
(define (describe-number n)
  (chain-when '()
    ((odd? n) (cons "odd" _))
    ((even? n) (cons "even" _))
    ((zero? n) (cons "zero" _))
    ((positive? n) (cons "positive" _))))

(describe-number 3) ; => '("positive" "odd")
(describe-number 4) ; => '("positive" "even")
#+END_SRC
**** Description
Each <step> is evaluated as an application. The return value of the step is passed to the next step as its pipeline value. <initial-value> is the pipeline value of the first step.

The <_> placeholder in each <step> is replaced with that step's pipeline value. If a <step> does not contain <_>, it will ignore its pipeline value

If a step's <guard> is present and evaluates to #f, that step will be skipped, and its pipeline value will be reused as the pipeline value of the next step. The return value of chain-when is the return value of the last non-skipped step, or <initial-value> if all steps are skipped.

Because chain-when may skip steps, it does not support steps with multiple return values. It is an error if a step returns more than one value.
*** chain-lambda
(chain-lambda [<placeholder> [<ellipsis>]] <step> ...)
**** Syntax
<placeholder> and <ellipsis> are literal symbols these are the placeholder symbol and ellipsis symbol. If <placeholder> or <ellipsis> are not present, they default to _ and ..., respectively.

The syntax of <step> is (<datum> ...), where each <datum> is either the placeholder symbol, the ellipsis symbol, or an expression. A <step> must contain at least one <datum>. The ellipsis symbol is only allowed at the end of a <step>, and it must immediately follow a placeholder symbol.
**** Semantics
Creates a procedure from a sequence of chain steps. When called, a chain-lambda procedure evaluates each <step> in order from left to right, passing the result of each step to the next.

#+BEGIN_SRC scheme
(chain-lambda (a _) (b _)) ; => (lambda (x) (let* ((x (a x))) (b x)))
(chain-lambda (a _ _) (b c _)) ; => (lambda (x1 x2) (let* ((x (a x1 x2))) (b c x)))
#+END_SRC

Each <step> is evaluated as an application, and the return value(s) of that application are passed to the next step as its pipeline values. The procedure's arguments are the pipeline values of the first step. The return value(s) of the procedure are the return value(s) of the last step.

The placeholder symbols in each <step> are replaced with that step's pipeline values, in the order they appear. It is an error if the number of placeholders for a step does not equal the number of pipeline values for that step, unless the step contains no placeholders, in which case it will ignore its pipeline values.

If a <step> ends with a placeholder symbol followed by an ellipsis symbol, that placeholder sequence is replaced with all remaining pipeline values that do not have a matching placeholder.

The number of placeholders in the first <step> determines the arity of the procedure. If the first step ends with an ellipsis symbol, the procedure is variadic.
*** nest
(nest [<placeholder>] <step> ... <initial-value>)
**** Syntax
<placeholder> is a literal symbol; this is the placeholder symbol. If <placeholder> is not present, the placeholder symbol is _. The syntax of <step> is (<datum> ... <_> <datum> ...), where <_> is the placeholder symbol. <initial-value> is expression.
**** Semantics
nest is similar to chain, but sequences its steps in the opposite order. Unlike chain, nest literally nests expressions; as a result, it does not provide the same strict evaluation order guarantees as chain.

#+BEGIN_SRC scheme
(nest (a b _) (c d _) e) ; => (a b (c d e))
#+END_SRC

A nest expression is evaluated by lexically replacing the <_> in the last <step> with <initial-value>, then replacing the <_> in the next-to-last <step> with that replacement, and so on until the <_> in the first <step> has been replaced. It is an error if the resulting final replacement is not an expression, which is then evaluated and its values are returned.

Because it produces an actual nested form, nest can build expressions that chain cannot. For example, nest can build a quoted data structure:

#+BEGIN_SRC scheme
(nest '_ (1 2 _) (3 _ 5) (_) 4) ; => '(1 2 (3 (4) 5))
#+END_SRC

nest can also safely include special forms like if, let, lambda, or parameterize in a pipeline.

A custom placeholder can be used to safely nest nest expressions.

#+BEGIN_SRC scheme
(nest (nest _2 '_2 (1 2 3 _2) _ 6)
      (_ 5 _2)
      4)
; => '(1 2 3 (4 5 6))
#+END_SRC
*** nest-reverse
(nest-reverse <initial-value> [<placeholder>] <step> ...)
**** Syntax
<initial-value> is an expression. <placeholder> is a literal symbol; this is the placeholder symbol. If <placeholder> is not present, the placeholder symbol is _.

The syntax of <step> is (<datum> ... <_> <datum> ...), where <_> is the placeholder symbol.
**** Semantics
nest-reverse is variant of nest that nests in reverse order, which is the same order as chain.

#+BEGIN_SRC scheme
(nest-reverse e (c d _) (a b _)) ; => (a b (c d e))
#+END_SRC

A nest-reverse expression is evaluated by lexically replacing the <_> in the first <step> with <initial-value>, then replacing the <_> in the second <step> with that replacement, and so on until the <_> in the last <step> has been replaced. It is an error if the resulting final replacement is not an expression, which is then evaluated and its values are returned.
** Implementation
A sample implementation is available on GitHub. This repository contains two portable SRFI 197 implementations, one in R7RS-small and syntax-rules, the other in R6RS and syntax-case. The only dependency of either implementation is SRFI 2. It includes an R7RS library wrapper and a test script.
** Acknowledgements
Thanks to the participants in the SRFI 197 mailing list who helped me refine this SRFI, including Marc Nieper-Wißkirchen, Linus Björnstam, Shiro Kawai, Lassi Kortela, and John Cowan.

Marc provided a paragraph that has been included (with only minor changes) in the Semantics section of the nest and nest-reverse macros.

Thanks to Rich Hickey for Clojure and the original implementation of Clojure threading macros, and to Paulus Esterhazy for the (EPL licensed) threading macros
documentation page, which was a source of inspiration and some of the examples in this document.
** Author
*** by Adam Nelson
*** Ported to Chicken Scheme 5 by Sergey Goldgaber
** Copyright
© 2020 Adam Nelson.

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice (including the next paragraph) shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
** Version history
 * [[https://github.com/diamond-lizard/srfi-197/releases/tag/0.1][0.1]] - Ported to Chicken Scheme 5


D README.svnwiki => README.svnwiki +0 -279
@@ 1,279 0,0 @@
== 197: Pipeline Operators
=== Abstract
Many functional languages provide pipeline operators, like Clojure's -> or OCaml's |>. Pipelines are a simple, terse, and readable way to write deeply-nested expressions. This SRFI defines a family of chain and nest pipeline operators, which can rewrite nested expressions like {{(a b (c d (e f g)))}} as a sequence of operations: {{(chain g (e f _) (c d _) (a b _))}}.

For more information see: [[https://srfi.schemers.org/srfi-197/|197: Pipeline Operators]]
=== Rationale
Deeply-nested expressions are a common problem in all functional languages, especially Lisps. Excessive nesting can result in deep indentation and parenthesis-matching
errors.

<enscript highlight="scheme">
; Quick, how many close parentheses are there?
(eta (zeta (epsilon (delta (gamma (beta (alpha)))))))
</enscript>

Additionally, some expressions sound more natural when written inside out, as a sequence of steps from start to finish.

<enscript highlight="scheme">
; This recipe looks… backwards.
(bake (pour (mix (add eggs (add sugar (add flour bowl))))) (fahrenheit 350))
</enscript>

Many functional languages solve this by introducing pipeline operators. This SRFI defines a chain operator inspired by Clojure's threading macros, but with _ as an
argument placeholder, a notation also used in SRFI 156.

<enscript highlight="scheme">
(chain (alpha) (beta _) (gamma _) (delta _) (epsilon _) (zeta _) (eta _))

(chain bowl
       (add flour _)
       (add sugar _)
       (add eggs _)
       (mix _)
       (pour _)
       (bake _ (fahrenheit 350)))
</enscript>

Pipelines are especially useful for nested list and vector operations.

<enscript highlight="scheme">
(chain xs
       (map (lambda (x) (+ x 1) _)
       (filter odd? _)
       (fold * 1 _))
</enscript>

Scheme already provides an idiomatic way to chain expressions in let* and SRFI 2 {{and-let*}}, but the primary advantage of chain is terseness and the accompanying
readability. This focus on readability and reduced nesting is similar in spirit to SRFI 156 and SRFI 26.

Compared to an equivalent {{let*}} expression, chain removes two levels of parenthesis nesting, does not define any intermediate variables, and allows mixing single and
multiple return values.

To demonstrate the difference in verbosity, here is the let* equivalent of the recipe expression:

<enscript highlight="scheme">
(let* ((x bowl)
       (x (add flour x))
       (x (add sugar x))
       (x (add eggs x))
       (x (mix x))
       (x (pour x)))
  (bake x (fahrenheit 350)))
</enscript>

Like let*, chain guarantees evaluation order. In fact, {{(chain a (b _) (c _))}} expands to something like {{(let* ((x (b a)) (x (c x))) x)}}, not {{(c (b a))}}, and so chain is not suitable for pipelines containing syntax like if or let.

For pipelines containing complex syntax, the nest and nest-reverse operators look like chain but are guaranteed to expand to nested forms, not let* forms. nest nests in the opposite direction of chain, so {{(nest (a _) (b _) c)}} expands to {{(a (b c))}}.
=== Specification
==== chain

<procedure>(chain <initial-value> [<placeholder> [<ellipsis>]] <step> ...)</procedure>

==== Syntax

<parameter><initial-value></parameter>

{{<initial-value>}} is an expression.


<parameter><placeholder></parameter>


<parameter><ellipsis></parameter>


{{<placeholder>}} and {{<ellipsis>}} are literal symbols; these are the placeholder symbol and ellipsis symbol. If {{<placeholder>}} or {{<ellipsis>}} are not present, they default to _ and ..., respectively.

<parameter><step></parameter>

The syntax of {{<step>}} is (<datum> ...), where each {{<datum>}} is either the placeholder symbol, the ellipsis symbol, or an expression. A {{<step>}} must contain at least one {{<datum>}}. The ellipsis symbol is only allowed at the end of a {{<step>}}, and it must immediately follow a placeholder symbol.
==== Semantics
chain evaluates each {{<step>}} in order from left to right, passing the result of each step to the next.

Each {{<step>}} is evaluated as an application, and the return value(s) of that application are passed to the next step as its pipeline values. {{<initial-value>}} is the pipeline value of the first step. The return value(s) of chain are the return value(s) of the last step.

The placeholder symbols in each {{<step>}} are replaced with that step's pipeline values, in the order they appear. It is an error if the number of placeholders for a step does not equal the number of pipeline values for that step, unless the step contains no placeholders, in which case it will ignore its pipeline values.

<enscript highlight="scheme">
(chain x (a b _)) ; => (a b x)
(chain (a b) (c _ d) (e f _)) ; => (let* ((x (a b)) (x (c x d))) (e f x))
(chain (a) (b _ _) (c _)) ; => (let*-values (((x1 x2) (a)) ((x) (b x1 x2))) (c x))
</enscript>

If a {{<step>}} ends with a placeholder symbol followed by an ellipsis symbol, that placeholder sequence is replaced with all remaining pipeline values that do not have a matching placeholder.

<enscript highlight="scheme">
(chain (a) (b _ c _ ...) (d _))
; => (let*-values (((x1 . x2) (a)) ((x) (apply b x1 c x2))) (d x))
</enscript>

chain and all other SRFI 197 macros support custom placeholder symbols, which can help to preserve hygiene when used in the body of a syntax definition that may insert a {{_}} or {{...}}.

<enscript highlight="scheme">
(chain (a b) <> (c <> d) (e f <>))
 ; => (let* ((x (a b)) (x (c x d))) (e f x))
(chain (a) - --- (b - c - ---) (d -))
; => (let*-values (((x1 . x2) (a)) ((x) (apply b x1 c x2))) (d x))
</enscript>
==== chain-and

<procedure>(chain-and <initial-value> [<placeholder>] <step> ...)</procedure>

===== Syntax

<parameter><initial-value></parameter>

{{<initial-value>}} is an expression.


<parameter><placeholder></parameter>

{{<placeholder>}} is a literal symbol; this is the placeholder symbol. If {{<placeholder>}} is not present, the placeholder symbol is {{_}}.


<parameter><step></parameter>

The syntax of {{<step>}} is (<datum> ... [<_> <datum> ...]), where {{<_>}} is the placeholder symbol.
===== Semantics
A variant of chain that short-circuits and returns {{#f}} if any step returns {{#f}}. chain-and is to chain as SRFI 2 {{and-let*}} is to {{let*}}.

Each {{<step>}} is evaluated as an application. If the step evaluates to {{#f}}, the remaining steps are not evaluated, and chain-and returns {{#f}}. Otherwise, the return value of the step is passed to the next step as its pipeline value. {{<initial-value>}} is the pipeline value of the first step. If no step evaluates to {{#f}}, the return value of chain-and is the return value of the last step.

The {{<_>}} placeholder in each {{<step>}} is replaced with that step's pipeline value. If a {{<step>}} does not contain {{<_>}}, it will ignore its pipeline value, but chain-and will still check whether that pipeline value is {{#f}}.

Because chain-and checks the return value of each step, it does not support steps with multiple return values. It is an error if a step returns more than one value.
==== chain-when

<procedure>(chain-when <initial-value> [<placeholder>] ([<guard>] <step>) ...)</procedure>

===== Syntax
{{<initial-value>}} and {{<guard>}} are expressions. {{<placeholder>}} is a literal symbol; this is the placeholder symbol. If {{<placeholder>}} is not present, the placeholder symbol is _. The syntax of {{<step>}} is (<datum> ... [<_> <datum> ...]), where {{<_>}} is the placeholder symbol.
===== Semantics
A variant of chain in which each step has a guard expression and will be skipped if the guard expression evaluates to {{#f}}.
===== Example
<enscript highlight="scheme">
(define (describe-number n)
  (chain-when '()
    ((odd? n) (cons "odd" _))
    ((even? n) (cons "even" _))
    ((zero? n) (cons "zero" _))
    ((positive? n) (cons "positive" _))))

(describe-number 3) ; => '("positive" "odd")
(describe-number 4) ; => '("positive" "even")
</enscript>
===== Description
Each {{<step>}} is evaluated as an application. The return value of the step is passed to the next step as its pipeline value. {{<initial-value>}} is the pipeline value of the first step.

The {{<_>}} placeholder in each {{<step>}} is replaced with that step's pipeline value. If a {{<step>}} does not contain {{<_>}}, it will ignore its pipeline value

If a step's {{<guard>}} is present and evaluates to {{#f}}, that step will be skipped, and its pipeline value will be reused as the pipeline value of the next step. The return value of chain-when is the return value of the last non-skipped step, or {{<initial-value>}} if all steps are skipped.

Because chain-when may skip steps, it does not support steps with multiple return values. It is an error if a step returns more than one value.
==== chain-lambda

<procedure>(chain-lambda [<placeholder> [<ellipsis>]] <step> ...)</procedure>

===== Syntax

<parameter><placeholder></parameter>


<parameter><ellipsis></parameter>

{{<placeholder>}} and {{<ellipsis>}} are literal symbols these are the placeholder symbol and ellipsis symbol. If {{<placeholder>}} or {{<ellipsis>}} are not present, they default to _ and ..., respectively.


<parameter><step></parameter>

The syntax of {{<step>}} is (<datum> ...), where each {{<datum>}} is either the placeholder symbol, the ellipsis symbol, or an expression. A {{<step>}} must contain at least one {{<datum>}}. The ellipsis symbol is only allowed at the end of a {{<step>}}, and it must immediately follow a placeholder symbol.
===== Semantics
Creates a procedure from a sequence of chain steps. When called, a {{chain-lambda}} procedure evaluates each {{<step>}} in order from left to right, passing the result of each step to the next.

<enscript highlight="scheme">
(chain-lambda (a _) (b _)) ; => (lambda (x) (let* ((x (a x))) (b x)))
(chain-lambda (a _ _) (b c _)) ; => (lambda (x1 x2) (let* ((x (a x1 x2))) (b c x)))
</enscript>

Each {{<step>}} is evaluated as an application, and the return value(s) of that application are passed to the next step as its pipeline values. The procedure's arguments are the pipeline values of the first step. The return value(s) of the procedure are the return value(s) of the last step.

The placeholder symbols in each {{<step>}} are replaced with that step's pipeline values, in the order they appear. It is an error if the number of placeholders for a step does not equal the number of pipeline values for that step, unless the step contains no placeholders, in which case it will ignore its pipeline values.

If a {{<step>}} ends with a placeholder symbol followed by an ellipsis symbol, that placeholder sequence is replaced with all remaining pipeline values that do not have a matching placeholder.

The number of placeholders in the first {{<step>}} determines the arity of the procedure. If the first step ends with an ellipsis symbol, the procedure is variadic.
==== nest

<procedure>(nest [<placeholder>] <step> ... <initial-value>)</procedure>

===== Syntax

<parameter><placeholder></parameter>

{{<placeholder>}} is a literal symbol; this is the placeholder symbol. If {{<placeholder>}} is not present, the placeholder symbol is _. The syntax of {{<step>}} is {{(<datum> ... <_> <datum> ...)}}, where {{<_>}} is the placeholder symbol. {{<initial-value>}} is expression.
===== Semantics
nest is similar to chain, but sequences its steps in the opposite order. Unlike chain, nest literally nests expressions; as a result, it does not provide the same strict evaluation order guarantees as chain.

<enscript highlight="scheme">
(nest (a b _) (c d _) e) ; => (a b (c d e))
</enscript>

A nest expression is evaluated by lexically replacing the {{<_>}} in the last {{<step>}} with {{<initial-value>}}, then replacing the {{<_>}} in the next-to-last {{<step>}} with that replacement, and so on until the {{<_>}} in the first {{<step>}} has been replaced. It is an error if the resulting final replacement is not an expression, which is then evaluated and its values are returned.

Because it produces an actual nested form, nest can build expressions that chain cannot. For example, nest can build a quoted data structure:

<enscript highlight="scheme">
(nest '_ (1 2 _) (3 _ 5) (_) 4) ; => '(1 2 (3 (4) 5))
</enscript>

nest can also safely include special forms like if, let, lambda, or parameterize in a pipeline.

A custom placeholder can be used to safely nest nest expressions.

<enscript highlight="scheme">
(nest (nest _2 '_2 (1 2 3 _2) _ 6)
      (_ 5 _2)
      4)
; => '(1 2 3 (4 5 6))
</enscript>
==== nest-reverse

<procedure>(nest-reverse <initial-value> [<placeholder>] <step> ...)</procedure>

===== Syntax

<parameter><initial-value></parameter>

{{<initial-value>}} is an expression. {{<placeholder>}} is a literal symbol; this is the placeholder symbol. If {{<placeholder>}} is not present, the placeholder symbol is _.

The syntax of {{<step>}} is (<datum> ... <_> <datum> ...), where {{<_>}} is the placeholder symbol.
===== Semantics
nest-reverse is variant of nest that nests in reverse order, which is the same order as chain.

<enscript highlight="scheme">
(nest-reverse e (c d _) (a b _)) ; => (a b (c d e))
</enscript>

A nest-reverse expression is evaluated by lexically replacing the {{<_>}} in the first {{<step>}} with {{<initial-value>}}, then replacing the {{<_>}} in the second {{<step>}} with that replacement, and so on until the {{<_>}} in the last {{<step>}} has been replaced. It is an error if the resulting final replacement is not an expression, which is then evaluated and its values are returned.
=== Implementation
A sample implementation is available on GitHub. This repository contains two portable SRFI 197 implementations, one in R7RS-small and syntax-rules, the other in R6RS and syntax-case. The only dependency of either implementation is SRFI 2. It includes an R7RS library wrapper and a test script.
=== Acknowledgements
Thanks to the participants in the SRFI 197 mailing list who helped me refine this SRFI, including Marc Nieper-Wißkirchen, Linus Björnstam, Shiro Kawai, Lassi Kortela, and John Cowan.

Marc provided a paragraph that has been included (with only minor changes) in the Semantics section of the nest and nest-reverse macros.

Thanks to Rich Hickey for Clojure and the original implementation of Clojure threading macros, and to Paulus Esterhazy for the (EPL licensed) threading macros
documentation page, which was a source of inspiration and some of the examples in this document.
=== Author
==== by Adam Nelson
==== Ported to Chicken Scheme 5 by Sergey Goldgaber
=== Copyright
© 2020 Adam Nelson.

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice (including the next paragraph) shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
=== Version history
* [[https://github.com/diamond-lizard/srfi-197/releases/tag/0.1|0.1]] - Ported to Chicken Scheme 5


M srfi-197-impl.scm => srfi-197-impl.scm +0 -165
@@ 1,165 0,0 @@

(define-syntax chain
  (syntax-rules …₁ ()
    ((_ initial-value) initial-value)
    ((_ initial-value (step …₁) …₁)
      (chain initial-value _ ... (step …₁) …₁))
    ((_ initial-value placeholder (step …₁) …₁)
      (chain initial-value placeholder ... (step …₁) …₁))
    ((_ initial-value placeholder ellipsis (first-step …₁) (next-step …₁) …₁)
      (let ()
        (define-syntax %chain
          (syntax-rules …₂ (placeholder ellipsis)
            ; (_ in-step out-step in-vars out-vars in-steps out-steps)
            ((_ () () () ((var) …₂) () (step …₂ last-step))
              (let* ((var step) …₂) last-step))
            ((_ () () () (vars …₂) () (step …₂ last-step))
              (let*-values ((vars step) …₂) last-step))
            ((_ () () () out-vars (step . in-steps) out-steps)
              (%chain step () () out-vars in-steps out-steps))
            ((_ () step () (out-vars …₂) in-steps (out-steps …₂))
              (%chain () () () (out-vars …₂ ignored) in-steps (out-steps …₂ step)))
            ((_ () step vars (out-vars …₂) in-steps (out-steps …₂))
              (%chain () () () (out-vars …₂ vars) in-steps (out-steps …₂ step)))
            ((_ (placeholder ellipsis) (step …₂) () (out-vars …₂) in-steps (out-steps …₂))
              (%chain () () () (out-vars …₂ chain-rest-var) in-steps (out-steps …₂ (apply step …₂ chain-rest-var))))
            ((_ (placeholder ellipsis) (step …₂) (vars …₂) (out-vars …₂) in-steps (out-steps …₂))
              (%chain () () () (out-vars …₂ (vars …₂ . chain-rest-var)) in-steps (out-steps …₂ (apply step …₂ chain-rest-var))))
            ((_ (placeholder ellipsis . rest) . _)
              (syntax-error "_ ... can only be used as a final argument"))
            ((_ (placeholder . in-step) (out-step …₂) (vars …₂) . rest)
              (%chain in-step (out-step …₂ chain-var) (vars …₂ chain-var) . rest))
            ((_ (x . in-step) (out-step …₂) . rest)
              (%chain in-step (out-step …₂ x) . rest))))
        (%chain (first-step …₁) () () () ((next-step …₁) …₁) (initial-value))))))

(define-syntax chain-and
  (syntax-rules …₁ ()
    ((_ initial-value) initial-value)
    ((_ initial-value (step …₁) …₁) (chain-and initial-value _ (step …₁) …₁))
    ((_ initial-value placeholder (first-step …₁) (next-step …₁) …₁)
      (let ()
        (define-syntax %chain-and
          (syntax-rules …₂ (placeholder)
            ; (_ in-step out-step in-vars out-vars in-steps out-steps)
            ((_ () () () (var …₂) () (step …₂ last-step))
              (and-let* ((var step) …₂) last-step))
            ((_ () () () out-vars (step . in-steps) out-steps)
              (%chain-and step () () out-vars in-steps out-steps))
            ((_ () step () (out-vars …₂) in-steps (out-steps …₂))
              (%chain-and () () () (out-vars …₂ ignored) in-steps (out-steps …₂ step)))
            ((_ () step (var) (out-vars …₂) in-steps (out-steps …₂))
              (%chain-and () () () (out-vars …₂ var) in-steps (out-steps …₂ step)))
            ((_ (placeholder . in-step) (out-step …₂) () . rest)
              (%chain-and in-step (out-step …₂ chain-var) (chain-var) . rest))
            ((_ (placeholder . excess) . rest)
              (syntax-error "chain-and does not support multiple _ in a single step"))
            ((_ (x . in-step) (out-step …₂) . rest)
              (%chain-and in-step (out-step …₂ x) . rest))))
        (%chain-and (first-step …₁) () () () ((next-step …₁) …₁) (initial-value))))))

(define-syntax chain-when
  (syntax-rules …₁ ()
    ((_ initial-value) initial-value)
    ((_ initial-value (guard? (step …₁)) …₁)
      (chain-when initial-value _ (guard? (step …₁)) …₁))
    ((_ initial-value placeholder (first-guard? (first-step …₁)) (next-guard? (next-step …₁)) …₁)
      (let ()
        (define-syntax %chain-when
          (syntax-rules …₂ (placeholder)
            ; (_ in-step out-step guard? chain-var in-steps out-expr)
            ((_ () () _1 _2 () out-expr) out-expr)
            ((_ () () _1 _2 ((guard? step) . in-steps) out-expr)
              (%chain-when step () guard? #f in-steps out-expr))
            ((_ () step guard? #f in-steps out-expr)
              (%chain-when () () #f #f in-steps
                (let ((chain-var out-expr))
                  (if guard? step chain-var))))
            ((_ () step guard? chain-var in-steps out-expr)
              (%chain-when () () #f #f in-steps
                (let ((chain-var out-expr))
                  (if guard? step chain-var))))
            ((_ (placeholder . in-step) (out-step …₂) guard? #f . rest)
              (%chain-when in-step (out-step …₂ chain-var) guard? chain-var . rest))
            ((_ (placeholder . excess) . rest)
              (syntax-error "chain-when does not support multiple _ in a single step"))
            ((_ (x . in-step) (out-step …₂) . rest)
              (%chain-when in-step (out-step …₂ x) . rest))))
        (%chain-when (first-step …₁) () first-guard? #f ((next-guard? (next-step …₁)) …₁) initial-value)))))

(define-syntax chain-lambda
  (syntax-rules …₁ ()
    ((_ (step …₁) …₁) (chain-lambda _ ... (step …₁) …₁))
    ((_ placeholder (step …₁) …₁) (chain-lambda placeholder ... (step …₁) …₁))
    ((_ placeholder ellipsis (first-step …₁) (next-step …₁) …₁)
      (let ()
        (define-syntax %chain-lambda
          (syntax-rules …₂ (placeholder ellipsis)
            ; (_ in-step out-step args rest-of-steps)
            ((_ () step args ())
              (lambda args step))
            ((_ () step args steps)
              (lambda args
                (chain step placeholder ellipsis . steps)))
            ((_ (placeholder ellipsis) (step …₂) () ())
              (lambda chain-rest-var (apply step …₂ chain-rest-var)))
            ((_ (placeholder ellipsis) (step …₂) () steps)
              (lambda chain-rest-var
                (chain (apply step …₂ chain-rest-var) placeholder ellipsis . steps)))
            ((_ (placeholder ellipsis) (step …₂) (args …₂) ())
              (lambda (args …₂ . chain-rest-var) (apply step …₂ chain-rest-var)))
            ((_ (placeholder ellipsis) (step …₂) (args …₂) steps)
              (lambda (args …₂ . chain-rest-var)
                (chain (apply step …₂ chain-rest-var) placeholder ellipsis . steps)))
            ((_ (placeholder ellipsis . excess) . rest)
              (syntax-error "_ ... can only be used as a final argument"))
            ((_ (placeholder . in-step) (out-step …₂) (args …₂) . rest)
              (%chain-lambda in-step (out-step …₂ chain-var) (args …₂ chain-var) . rest))
            ((_ (x . in-step) (out-step …₂) . rest)
              (%chain-lambda in-step (out-step …₂ x) . rest))))
        (%chain-lambda (first-step …₁) () () ((next-step …₁) …₁))))))

(define-syntax nest
  (syntax-rules …₁ (_)
    ((nest last) last)
    ((nest (step …₁) …₁ last) (nest _ (step …₁) …₁ last))
    ((nest placeholder (extra-step …₁) …₁ (first-step …₁) last)
      (let ()
        ; let-syntax is buggy in some Schemes, define-syntax is more reliable
        (define-syntax %nest
          (syntax-rules …₂ (placeholder)
            ((%nest result () placeholder ()) result)
            ((%nest result () placeholder (rest …₂ step))
              (%nest () step result (rest …₂)))
            ((%nest result () accum steps)
              (syntax-error "nest: step must contain _"))
            ((%nest result (placeholder . rest) placeholder steps)
              (syntax-error "nest: only one _ allowed per step"))
            ((%nest (result …₂) (placeholder . rest) accum steps)
              (%nest (result …₂ accum) rest placeholder steps))
            ((%nest (result …₂) (element . rest) accum steps)
              (%nest (result …₂ element) rest accum steps))))
        (%nest () (first-step …₁) last ((extra-step …₁) …₁))))
    ((nest placeholder last) last)))

(define-syntax nest-reverse
  (syntax-rules …₁ (_)
    ((nest-reverse first) first)
    ((nest-reverse first (step …₁) …₁) (nest-reverse first _ (step …₁) …₁))
    ((nest-reverse first placeholder (first-step …₁) (extra-step …₁) …₁)
      (let ()
        (define-syntax %nest
          (syntax-rules …₂ (placeholder)
            ((%nest result () placeholder ()) result)
            ((%nest result () placeholder (step . rest))
              (%nest () step result rest))
            ((%nest result () accum steps)
              (syntax-error "nest-reverse: step must contain _"))
            ((%nest result (placeholder . rest) placeholder steps)
              (syntax-error "nest-reverse: only one _ allowed per step"))
            ((%nest (result …₂) (placeholder . rest) accum steps)
              (%nest (result …₂ accum) rest placeholder steps))
            ((%nest (result …₂) (element . rest) accum steps)
              (%nest (result …₂ element) rest accum steps))))
        (%nest () (first-step …₁) first ((extra-step …₁) …₁))))
    ((nest-reverse first placeholder) first)))


D srfi-197-syntax-case.scm => srfi-197-syntax-case.scm +0 -176
@@ 1,176 0,0 @@
; A syntax-case implementation of SRFI 197.
; This should be functionally equivalent to srfi-197.scm,
; but it may be easier to read and understand.

(define (gentemp) (car (generate-temporaries '(x))))

(define (id=? x y) (and (identifier? x) (free-identifier=? x y)))

(define-syntax chain
  (lambda (x)
    (syntax-case x ()
      ((_ initial-value (step ...) ...)
        #'(chain initial-value _ (... ...) (step ...) ...))
      ((_ initial-value placeholder (step ...) ...)
        #'(chain initial-value placeholder (... ...) (step ...) ...))
      ((_ initial-value placeholder ellipsis) (and (identifier? #'placeholder)
                                                   (identifier? #'ellipsis))
        #'initial-value)
      ((_ initial-value placeholder ellipsis (step ...) rest ...)
        (let loop ((vars '()) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u …) (and (id=? #'u #'placeholder) (id=? #'… #'ellipsis))
              (let ((chain-rest-var (gentemp)))
                #`(chain (let-values ((#,(if (null? vars)
                                           chain-rest-var
                                           #`(#,@(reverse vars) . #,chain-rest-var))
                                       initial-value))
                           (apply #,@(reverse out) #,chain-rest-var))
                         placeholder
                         ellipsis
                         rest ...)))
            ((u … . _) (and (id=? #'u #'placeholder) (id=? #'… #'ellipsis))
              (syntax-violation 'chain "_ ... only allowed at end" #'(step ...)))
            ((u . step-rest) (id=? #'u #'placeholder)
              (let ((chain-var (gentemp)))
                (loop (cons chain-var vars) (cons chain-var out) #'step-rest)))
            ((… . _) (id=? #'… #'ellipsis)
              (syntax-violation 'chain "misplaced ..." #'(step ...)))
            ((x . step-rest)
              (loop vars (cons #'x out) #'step-rest))
            (()
              (with-syntax ((result (reverse out)))
                #`(chain
                    #,(cond
                        ((null? vars)
                          #'(begin initial-value result))
                        ((null? (cdr vars))
                          #`(let ((#,(car vars) initial-value)) result))
                        (else
                          #`(let-values ((#,(reverse vars) initial-value)) result)))
                    placeholder
                    ellipsis
                    rest ...)))))))))

(define-syntax chain-and
  (lambda (x)
    (syntax-case x ()
      ((_ initial-value (step ...) ...)
        #'(chain-and initial-value _ (step ...) ...))
      ((_ initial-value placeholder) (identifier? #'placeholder)
        #'initial-value)
      ((_ initial-value placeholder (step ...) rest ...)
        (let loop ((var #f) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u . step-rest) (id=? #'u #'placeholder)
              (if var
                (syntax-violation 'chain-and "only one _ allowed per step" #'(step ...))
                (let ((chain-var (gentemp)))
                  (loop chain-var (cons chain-var out) #'step-rest))))
            ((x . step-rest)
              (loop var (cons #'x out) #'step-rest))
            (()
              (with-syntax ((result (reverse out)))
                #`(chain-and
                    #,(if var
                        #`(let ((#,var initial-value))
                            (and #,var result))
                        #'(and initial-value result))
                    placeholder
                    rest ...)))))))))

(define-syntax chain-when
  (lambda (x)
    (syntax-case x ()
      ((_ initial-value (guard? (step ...)) ...)
        #'(chain-when initial-value _ (guard? (step ...)) ...))
      ((_ initial-value placeholder) (identifier? #'placeholder)
        #'initial-value)
      ((_ initial-value placeholder (guard? (step ...)) rest ...)
        (let loop ((var #f) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u . step-rest) (id=? #'u #'placeholder)
              (if var
                (syntax-violation 'chain-when "only one _ allowed per step" #'(step ...))
                (let ((chain-var (gentemp)))
                  (loop chain-var (cons chain-var out) #'step-rest))))
            ((x . step-rest)
              (loop var (cons #'x out) #'step-rest))
            (()
              (with-syntax ((result (reverse out)))
                #`(chain-when
                    #,(if var
                        #`(let ((#,var initial-value))
                            (if guard? result #,var))
                        #'(let ((chain-var initial-value))
                            (if guard? result chain-var)))
                    placeholder
                    rest ...)))))))))

(define-syntax chain-lambda
  (lambda (x)
    (syntax-case x ()
      ((_ (step ...) ...)
        #'(chain-lambda _ (... ...) (step ...) ...))
      ((_ placeholder (step ...) ...)
        #'(chain-lambda placeholder (... ...) (step ...) ...))
      ((_ placeholder ellipsis (first-step ...) rest ...)
        (let loop ((vars '()) (out '()) (in #'(first-step ...)))
          (syntax-case in ()
            ((u …) (and (id=? #'u #'placeholder) (id=? #'… #'ellipsis))
              (let ((chain-rest-var (gentemp)))
                #`(lambda #,(if (null? vars)
                              chain-rest-var
                              #`(#,@vars . #,chain-rest-var))
                    (chain (apply #,@(reverse out) #,chain-rest-var) placeholder ellipsis rest ...))))
            ((u … . _) (and (id=? #'u #'placeholder) (id=? #'… #'ellipsis))
              (syntax-violation 'chain-lambda "_ ... only allowed at end" #'(first-step ...)))
            ((u . step-rest) (id=? #'u #'placeholder)
              (let ((chain-var (gentemp)))
                (loop (cons chain-var vars) (cons chain-var out) #'step-rest)))
            ((… . _) (id=? #'… #'ellipsis)
              (syntax-violation 'chain-lambda "misplaced ..." #'(first-step ...)))
            ((x . step-rest)
              (loop vars (cons #'x out) #'step-rest))
            (()
              #`(lambda #,(reverse vars) (chain #,(reverse out) placeholder ellipsis rest ...)))))))))

(define-syntax nest
  (lambda (x)
    (syntax-case x ()
      ((_ last) #'last)
      ((_ (step ...) ... last) #'(nest _ (step ...) ... last))
      ((_ placeholder (extra-step ...) ... (step ...) last)
        (let loop ((arg #'last) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u . step-rest) (id=? #'u #'placeholder)
              (if (eof-object? arg)
                (syntax-violation 'nest "only one _ allowed per step" #'(step ...))
                (loop (eof-object) (cons arg out) #'step-rest)))
            ((x . step-rest)
              (loop arg (cons #'x out) #'step-rest))
            (()
              (if (eof-object? arg)
                #`(nest placeholder (extra-step ...) ... #,(reverse out))
                (syntax-violation 'nest "step must contain _" #'(step ...)))))))
      ((_ placeholder last) #'last))))

(define-syntax nest-reverse
  (lambda (x)
    (syntax-case x ()
      ((_ first) #'first)
      ((_ first (step ...) ...) #'(nest-reverse first _ (step ...) ...))
      ((_ first placeholder (step ...) (extra-step ...) ...)
        (let loop ((arg #'first) (out '()) (in #'(step ...)))
          (syntax-case in ()
            ((u . step-rest) (id=? #'u #'placeholder)
              (if (eof-object? arg)
                (syntax-violation 'nest-reverse "only one _ allowed per step" #'(step ...))
                (loop (eof-object) (cons arg out) #'step-rest)))
            ((x . step-rest)
              (loop arg (cons #'x out) #'step-rest))
            (()
              (if (eof-object? arg)
                #`(nest-reverse #,(reverse out) placeholder (extra-step ...) ...)
                (syntax-violation 'nest-reverse "step must contain _" #'(step ...)))))))
      ((_ first placeholder) #'first))))


M srfi-197.egg => srfi-197.egg +1 -2
@@ 1,11 1,10 @@
;;; srfi-197.egg -*- Scheme -*- vim: ft=scheme:

((author "Adam Nelson")
 (maintainer "Sergey Goldgaber")
 (maintainer "Diego A. Mundo")
 (synopsis "SRFI-197: Pipeline Operators")
 (version "0.1")
 (category lang-exts)
 (dependencies r7rs)
 (test-dependencies test)
 (license "MIT")
 (components (extension srfi-197)))


M srfi-197.release-info => srfi-197.release-info +1 -0
@@ 1,4 1,5 @@
(repo git "https://code.dieggsy.com/{egg-name}")

(uri targz "https://code.dieggsy.com/{egg-name}/snapshot/{egg-name}-{egg-release}.tar.gz")
(release "0.2.0")
(release "0.1")


M srfi-197.scm => srfi-197.scm +175 -6
@@ 1,8 1,177 @@
(import scheme)
(import (chicken base))
(import (chicken platform))
(import (only r7rs define-library))
(module srfi-197 (chain
                  chain-and
                  chain-when
                  chain-lambda
                  nest
                  nest-reverse)

(register-feature! 'srfi-197)
  (import scheme)

(include "srfi-197.sld")
  (import (only (chicken platform) register-feature!))

  (begin (register-feature! 'srfi-197))

  (define-syntax chain
    (syntax-rules …₁ ()
      ((_ initial-value) initial-value)
      ((_ initial-value (step …₁) …₁)
        (chain initial-value _ ... (step …₁) …₁))
      ((_ initial-value placeholder (step …₁) …₁)
        (chain initial-value placeholder ... (step …₁) …₁))
      ((_ initial-value placeholder ellipsis (first-step …₁) (next-step …₁) …₁)
        (let ()
          (define-syntax %chain
            (syntax-rules …₂ (placeholder ellipsis)
              ; (_ in-step out-step in-vars out-vars in-steps out-steps)
              ((_ () () () ((var) …₂) () (step …₂ last-step))
                (let* ((var step) …₂) last-step))
              ((_ () () () (vars …₂) () (step …₂ last-step))
                (let*-values ((vars step) …₂) last-step))
              ((_ () () () out-vars (step . in-steps) out-steps)
                (%chain step () () out-vars in-steps out-steps))
              ((_ () step () (out-vars …₂) in-steps (out-steps …₂))
                (%chain () () () (out-vars …₂ ignored) in-steps (out-steps …₂ step)))
              ((_ () step vars (out-vars …₂) in-steps (out-steps …₂))
                (%chain () () () (out-vars …₂ vars) in-steps (out-steps …₂ step)))
              ((_ (placeholder ellipsis) (step …₂) () (out-vars …₂) in-steps (out-steps …₂))
                (%chain () () () (out-vars …₂ chain-rest-var) in-steps (out-steps …₂ (apply step …₂ chain-rest-var))))
              ((_ (placeholder ellipsis) (step …₂) (vars …₂) (out-vars …₂) in-steps (out-steps …₂))
                (%chain () () () (out-vars …₂ (vars …₂ . chain-rest-var)) in-steps (out-steps …₂ (apply step …₂ chain-rest-var))))
              ((_ (placeholder ellipsis . rest) . _)
                (syntax-error "_ ... can only be used as a final argument"))
              ((_ (placeholder . in-step) (out-step …₂) (vars …₂) . rest)
                (%chain in-step (out-step …₂ chain-var) (vars …₂ chain-var) . rest))
              ((_ (x . in-step) (out-step …₂) . rest)
                (%chain in-step (out-step …₂ x) . rest))))
          (%chain (first-step …₁) () () () ((next-step …₁) …₁) (initial-value))))))

  (define-syntax chain-and
    (syntax-rules …₁ ()
      ((_ initial-value) initial-value)
      ((_ initial-value (step …₁) …₁) (chain-and initial-value _ (step …₁) …₁))
      ((_ initial-value placeholder (first-step …₁) (next-step …₁) …₁)
        (let ()
          (define-syntax %chain-and
            (syntax-rules …₂ (placeholder)
              ; (_ in-step out-step in-vars out-vars in-steps out-steps)
              ((_ () () () (var …₂) () (step …₂ last-step))
                (and-let* ((var step) …₂) last-step))
              ((_ () () () out-vars (step . in-steps) out-steps)
                (%chain-and step () () out-vars in-steps out-steps))
              ((_ () step () (out-vars …₂) in-steps (out-steps …₂))
                (%chain-and () () () (out-vars …₂ ignored) in-steps (out-steps …₂ step)))
              ((_ () step (var) (out-vars …₂) in-steps (out-steps …₂))
                (%chain-and () () () (out-vars …₂ var) in-steps (out-steps …₂ step)))
              ((_ (placeholder . in-step) (out-step …₂) () . rest)
                (%chain-and in-step (out-step …₂ chain-var) (chain-var) . rest))
              ((_ (placeholder . excess) . rest)
                (syntax-error "chain-and does not support multiple _ in a single step"))
              ((_ (x . in-step) (out-step …₂) . rest)
                (%chain-and in-step (out-step …₂ x) . rest))))
          (%chain-and (first-step …₁) () () () ((next-step …₁) …₁) (initial-value))))))

  (define-syntax chain-when
    (syntax-rules …₁ ()
      ((_ initial-value) initial-value)
      ((_ initial-value (guard? (step …₁)) …₁)
        (chain-when initial-value _ (guard? (step …₁)) …₁))
      ((_ initial-value placeholder (first-guard? (first-step …₁)) (next-guard? (next-step …₁)) …₁)
        (let ()
          (define-syntax %chain-when
            (syntax-rules …₂ (placeholder)
              ; (_ in-step out-step guard? chain-var in-steps out-expr)
              ((_ () () _1 _2 () out-expr) out-expr)
              ((_ () () _1 _2 ((guard? step) . in-steps) out-expr)
                (%chain-when step () guard? #f in-steps out-expr))
              ((_ () step guard? #f in-steps out-expr)
                (%chain-when () () #f #f in-steps
                  (let ((chain-var out-expr))
                    (if guard? step chain-var))))
              ((_ () step guard? chain-var in-steps out-expr)
                (%chain-when () () #f #f in-steps
                  (let ((chain-var out-expr))
                    (if guard? step chain-var))))
              ((_ (placeholder . in-step) (out-step …₂) guard? #f . rest)
                (%chain-when in-step (out-step …₂ chain-var) guard? chain-var . rest))
              ((_ (placeholder . excess) . rest)
                (syntax-error "chain-when does not support multiple _ in a single step"))
              ((_ (x . in-step) (out-step …₂) . rest)
                (%chain-when in-step (out-step …₂ x) . rest))))
          (%chain-when (first-step …₁) () first-guard? #f ((next-guard? (next-step …₁)) …₁) initial-value)))))

  (define-syntax chain-lambda
    (syntax-rules …₁ ()
      ((_ (step …₁) …₁) (chain-lambda _ ... (step …₁) …₁))
      ((_ placeholder (step …₁) …₁) (chain-lambda placeholder ... (step …₁) …₁))
      ((_ placeholder ellipsis (first-step …₁) (next-step …₁) …₁)
        (let ()
          (define-syntax %chain-lambda
            (syntax-rules …₂ (placeholder ellipsis)
              ; (_ in-step out-step args rest-of-steps)
              ((_ () step args ())
                (lambda args step))
              ((_ () step args steps)
                (lambda args
                  (chain step placeholder ellipsis . steps)))
              ((_ (placeholder ellipsis) (step …₂) () ())
                (lambda chain-rest-var (apply step …₂ chain-rest-var)))
              ((_ (placeholder ellipsis) (step …₂) () steps)
                (lambda chain-rest-var
                  (chain (apply step …₂ chain-rest-var) placeholder ellipsis . steps)))
              ((_ (placeholder ellipsis) (step …₂) (args …₂) ())
                (lambda (args …₂ . chain-rest-var) (apply step …₂ chain-rest-var)))
              ((_ (placeholder ellipsis) (step …₂) (args …₂) steps)
                (lambda (args …₂ . chain-rest-var)
                  (chain (apply step …₂ chain-rest-var) placeholder ellipsis . steps)))
              ((_ (placeholder ellipsis . excess) . rest)
                (syntax-error "_ ... can only be used as a final argument"))
              ((_ (placeholder . in-step) (out-step …₂) (args …₂) . rest)
                (%chain-lambda in-step (out-step …₂ chain-var) (args …₂ chain-var) . rest))
              ((_ (x . in-step) (out-step …₂) . rest)
                (%chain-lambda in-step (out-step …₂ x) . rest))))
          (%chain-lambda (first-step …₁) () () ((next-step …₁) …₁))))))

  (define-syntax nest
    (syntax-rules …₁ (_)
      ((nest last) last)
      ((nest (step …₁) …₁ last) (nest _ (step …₁) …₁ last))
      ((nest placeholder (extra-step …₁) …₁ (first-step …₁) last)
        (let ()
          ; let-syntax is buggy in some Schemes, define-syntax is more reliable
          (define-syntax %nest
            (syntax-rules …₂ (placeholder)
              ((%nest result () placeholder ()) result)
              ((%nest result () placeholder (rest …₂ step))
                (%nest () step result (rest …₂)))
              ((%nest result () accum steps)
                (syntax-error "nest: step must contain _"))
              ((%nest result (placeholder . rest) placeholder steps)
                (syntax-error "nest: only one _ allowed per step"))
              ((%nest (result …₂) (placeholder . rest) accum steps)
                (%nest (result …₂ accum) rest placeholder steps))
              ((%nest (result …₂) (element . rest) accum steps)
                (%nest (result …₂ element) rest accum steps))))
          (%nest () (first-step …₁) last ((extra-step …₁) …₁))))
      ((nest placeholder last) last)))

  (define-syntax nest-reverse
    (syntax-rules …₁ (_)
      ((nest-reverse first) first)
      ((nest-reverse first (step …₁) …₁) (nest-reverse first _ (step …₁) …₁))
      ((nest-reverse first placeholder (first-step …₁) (extra-step …₁) …₁)
        (let ()
          (define-syntax %nest
            (syntax-rules …₂ (placeholder)
              ((%nest result () placeholder ()) result)
              ((%nest result () placeholder (step . rest))
                (%nest () step result rest))
              ((%nest result () accum steps)
                (syntax-error "nest-reverse: step must contain _"))
              ((%nest result (placeholder . rest) placeholder steps)
                (syntax-error "nest-reverse: only one _ allowed per step"))
              ((%nest (result …₂) (placeholder . rest) accum steps)
                (%nest (result …₂ accum) rest placeholder steps))
              ((%nest (result …₂) (element . rest) accum steps)
                (%nest (result …₂ element) rest accum steps))))
          (%nest () (first-step …₁) first ((extra-step …₁) …₁))))
      ((nest-reverse first placeholder) first))))


D srfi-197.sld => srfi-197.sld +0 -6
@@ 1,6 0,0 @@
(define-library (srfi-197)
  (export chain chain-and chain-when chain-lambda nest nest-reverse)

  (import (scheme base))

  (include "srfi-197-impl.scm"))


A srfi-197.svnwiki => srfi-197.svnwiki +367 -0
@@ 0,0 1,367 @@
[[toc:]]

== srfi-197: Pipeline Operators

=== Abstract

Many functional languages provide pipeline operators, like Clojure's {{->}} or
OCaml's {{|>}}. Pipelines are a simple, terse, and readable way to write
deeply-nested expressions. This SRFI defines a family of {{chain}} and {{nest}}
pipeline operators, which can rewrite nested expressions like {{(a b (c d (e f
g)))}} as a sequence of operations: {{(chain g (e f _) (c d _) (a b _))}}.

For more information see:
[[https://srfi.schemers.org/srfi-197/|197: Pipeline Operators]]

=== Rationale

Deeply-nested expressions are a common problem in all functional languages,
especially Lisps. Excessive nesting can result in deep indentation and
parenthesis-matching errors.

<enscript highlight="scheme">
; Quick, how many close parentheses are there?
(eta (zeta (epsilon (delta (gamma (beta (alpha)))))))
</enscript>

Additionally, some expressions sound more natural when written inside out, as a
sequence of steps from start to finish.

<enscript highlight="scheme">
; This recipe looks… backwards.
(bake (pour (mix (add eggs (add sugar (add flour bowl))))) (fahrenheit 350))
</enscript>

Many functional languages solve this by introducing pipeline operators. This
SRFI defines a {{chain}} operator inspired by Clojure's threading macros, but
with {{_}} as an argument placeholder, a notation also used in SRFI 156.

<enscript highlight="scheme">
(chain (alpha) (beta _) (gamma _) (delta _) (epsilon _) (zeta _) (eta _))

(chain bowl
       (add flour _)
       (add sugar _)
       (add eggs _)
       (mix _)
       (pour _)
       (bake _ (fahrenheit 350)))
</enscript>

Pipelines are especially useful for nested list and vector operations.

<enscript highlight="scheme">
(chain xs
       (map (lambda (x) (+ x 1) _)
       (filter odd? _)
       (fold * 1 _))
</enscript>

Scheme already provides an idiomatic way to chain expressions in {{let*}} and
SRFI 2 {{and-let*}}, but the primary advantage of {{chain}} is terseness and
the accompanying readability. This focus on readability and reduced nesting is
similar in spirit to SRFI 156 and SRFI 26.

Compared to an equivalent {{let*}} expression, {{chain}} removes two levels of
parenthesis nesting, does not define any intermediate variables, and allows
mixing single and multiple return values.

To demonstrate the difference in verbosity, here is the {{let*}} equivalent of the
recipe expression:

<enscript highlight="scheme">
(let* ((x bowl)
       (x (add flour x))
       (x (add sugar x))
       (x (add eggs x))
       (x (mix x))
       (x (pour x)))
  (bake x (fahrenheit 350)))
</enscript>

Like {{let*}}, chain guarantees evaluation order. In fact, {{(chain a (b _) (c
_))}} expands to something like {{(let* ((x (b a)) (x (c x))) x)}}, not {{(c (b
a))}}, and so {{chain}} is not suitable for pipelines containing syntax like
{{if}} or {{let}}.

For pipelines containing complex syntax, the {{nest}} and {{nest-reverse}}
operators look like {{chain}} but are guaranteed to expand to nested forms, not
{{let*}} forms. {{nest}} nests in the opposite direction of {{chain}}, so
{{(nest (a _) (b _) c)}} expands to {{(a (b c))}}.

=== Specification

==== chain

<procedure>(chain <initial-value> [<placeholder> [<ellipsis>]] <step> ...)</procedure>

{{chain}} evaluates each {{<step>}} in order from left to right, passing the result
of each step to the next.

{{<initial-value>}} is an expression. {{<placeholder>}} and {{<ellipsis>}} are
literal symbols; these are the placeholder symbol and ellipsis symbol. If
{{<placeholder>}} or {{<ellipsis>}} are not present, they default to {{_}} and
{{...}}, respectively.

The syntax of {{<step>}} is {{(<datum> ...)}}, where each {{<datum>}} is either
the placeholder symbol, the ellipsis symbol, or an expression. A {{<step>}}
must contain at least one {{<datum>}}. The ellipsis symbol is only allowed at
the end of a {{<step>}}, and it must immediately follow a placeholder symbol.

Each {{<step>}} is evaluated as an application, and the return value(s) of that
application are passed to the next step as its pipeline values.
{{<initial-value>}} is the pipeline value of the first step. The return
value(s) of {{chain}} are the return value(s) of the last step.

The placeholder symbols in each {{<step>}} are replaced with that step's
pipeline values, in the order they appear. It is an error if the number of
placeholders for a step does not equal the number of pipeline values for that
step, unless the step contains no placeholders, in which case it will ignore
its pipeline values.

<enscript highlight="scheme">
(chain x (a b _)) ; => (a b x)
(chain (a b) (c _ d) (e f _)) ; => (let* ((x (a b)) (x (c x d))) (e f x))
(chain (a) (b _ _) (c _)) ; => (let*-values (((x1 x2) (a)) ((x) (b x1 x2))) (c x))
</enscript>

If a {{<step>}} ends with a placeholder symbol followed by an ellipsis symbol,
that placeholder sequence is replaced with all remaining pipeline values that
do not have a matching placeholder.

<enscript highlight="scheme">
(chain (a) (b _ c _ ...) (d _))
; => (let*-values (((x1 . x2) (a)) ((x) (apply b x1 c x2))) (d x))
</enscript>

{{chain}} and all other SRFI 197 macros support custom placeholder symbols,
which can help to preserve hygiene when used in the body of a syntax definition
that may insert a {{_}} or {{...}}.

<enscript highlight="scheme">
(chain (a b) <> (c <> d) (e f <>))
 ; => (let* ((x (a b)) (x (c x d))) (e f x))
(chain (a) - --- (b - c - ---) (d -))
; => (let*-values (((x1 . x2) (a)) ((x) (apply b x1 c x2))) (d x))
</enscript>

==== chain-and

<procedure>(chain-and <initial-value> [<placeholder>] <step> ...)</procedure>

A variant of {{chain}} that short-circuits and returns {{#f}} if any step
returns {{#f}}. {{chain-and}} is to chain as SRFI 2 {{and-let*}} is to
{{let*}}.

{{<initial-value>}} is an expression. {{<placeholder>}} is a literal symbol;
this is the placeholder symbol. If {{<placeholder>}} is not present, the
placeholder symbol is {{_}}.

The syntax of {{<step>}} is {{(<datum> ... [<_> <datum> ...])}}, where {{<_>}}
is the placeholder symbol.

Each {{<step>}} is evaluated as an application. If the step evaluates to
{{#f}}, the remaining steps are not evaluated, and {{chain-and}} returns
{{#f}}. Otherwise, the return value of the step is passed to the next step as
its pipeline value. {{<initial-value>}} is the pipeline value of the first
step. If no step evaluates to {{#f}}, the return value of {{chain-and}} is the
return value of the last step.

The {{<_>}} placeholder in each {{<step>}} is replaced with that step's
pipeline value. If a {{<step>}} does not contain {{<_>}}, it will ignore its
pipeline value, but {{chain-and}} will still check whether that pipeline value is
{{#f}}.

Because {{chain-and}} checks the return value of each step, it does not support
steps with multiple return values. It is an error if a step returns more than
one value.

==== chain-when

<procedure>(chain-when <initial-value> [<placeholder>] ([<guard>] <step>) ...)</procedure>

A variant of {{chain}} in which each step has a guard expression and will be
skipped if the guard expression evaluates to {{#f}}.

{{<initial-value>}} and {{<guard>}} are expressions. {{<placeholder>}} is a
literal symbol; this is the placeholder symbol. If {{<placeholder>}} is not
present, the placeholder symbol is {{_}}. The syntax of {{<step>}} is
{{(<datum> ... [<_> <datum> ...])}}, where {{<_>}} is the placeholder symbol.

<enscript highlight="scheme">
(define (describe-number n)
  (chain-when '()
    ((odd? n) (cons "odd" _))
    ((even? n) (cons "even" _))
    ((zero? n) (cons "zero" _))
    ((positive? n) (cons "positive" _))))

(describe-number 3) ; => '("positive" "odd")
(describe-number 4) ; => '("positive" "even")
</enscript>

Each {{<step>}} is evaluated as an application. The return value of the step is
passed to the next step as its pipeline value. {{<initial-value>}} is the
pipeline value of the first step.

The {{<_>}} placeholder in each {{<step>}} is replaced with that step's
pipeline value. If a {{<step>}} does not contain {{<_>}}, it will ignore its
pipeline value

If a step's {{<guard>}} is present and evaluates to {{#f}}, that step will be
skipped, and its pipeline value will be reused as the pipeline value of the
next step. The return value of {{chain-when}} is the return value of the last
non-skipped step, or {{<initial-value>}} if all steps are skipped.

Because {{chain-when}} may skip steps, it does not support steps with multiple
return values. It is an error if a step returns more than one value.

==== chain-lambda

<procedure>(chain-lambda [<placeholder> [<ellipsis>]] <step> ...)</procedure>

Creates a procedure from a sequence of chain steps. When called, a
{{chain-lambda}} procedure evaluates each {{<step>}} in order from left to
right, passing the result of each step to the next.

{{<placeholder>}} and {{<ellipsis>}} are literal symbols these are the
placeholder symbol and ellipsis symbol. If {{<placeholder>}} or {{<ellipsis>}}
are not present, they default to {{_}} and {{...}}, respectively.

The syntax of {{<step>}} is {{(<datum> ...)}}, where each {{<datum>}} is either
the placeholder symbol, the ellipsis symbol, or an expression. A {{<step>}}
must contain at least one {{<datum>}}. The ellipsis symbol is only allowed at
the end of a {{<step>}}, and it must immediately follow a placeholder symbol.

<enscript highlight="scheme">
(chain-lambda (a _) (b _)) ; => (lambda (x) (let* ((x (a x))) (b x)))
(chain-lambda (a _ _) (b c _)) ; => (lambda (x1 x2) (let* ((x (a x1 x2))) (b c x)))
</enscript>

Each {{<step>}} is evaluated as an application, and the return value(s) of that
application are passed to the next step as its pipeline values. The procedure's
arguments are the pipeline values of the first step. The return value(s) of the
procedure are the return value(s) of the last step.

The placeholder symbols in each {{<step>}} are replaced with that step's
pipeline values, in the order they appear. It is an error if the number of
placeholders for a step does not equal the number of pipeline values for that
step, unless the step contains no placeholders, in which case it will ignore
its pipeline values.

If a {{<step>}} ends with a placeholder symbol followed by an ellipsis symbol,
that placeholder sequence is replaced with all remaining pipeline values that
do not have a matching placeholder.

The number of placeholders in the first {{<step>}} determines the arity of the
procedure. If the first step ends with an ellipsis symbol, the procedure is
variadic.

==== nest

<procedure>(nest [<placeholder>] <step> ... <initial-value>)</procedure>

{{nest}} is similar to {{chain}}, but sequences its steps in the opposite
order. Unlike chain, nest literally nests expressions; as a result, it does not
provide the same strict evaluation order guarantees as chain.

{{<placeholder>}} is a literal symbol; this is the placeholder symbol. If
{{<placeholder>}} is not present, the placeholder symbol is {{_}}. The syntax
of {{<step>}} is {{(<datum> ... <_> <datum> ...)}}, where {{<_>}} is the
placeholder symbol. {{<initial-value>}} is expression.

<enscript highlight="scheme">
(nest (a b _) (c d _) e) ; => (a b (c d e))
</enscript>

A {{nest}} expression is evaluated by lexically replacing the {{<_>}} in the
last {{<step>}} with {{<initial-value>}}, then replacing the {{<_>}} in the
next-to-last {{<step>}} with that replacement, and so on until the {{<_>}} in
the first {{<step>}} has been replaced. It is an error if the resulting final
replacement is not an expression, which is then evaluated and its values are
returned.

Because it produces an actual nested form, {{nest}} can build expressions that
chain cannot. For example, {{nest}} can build a quoted data structure:

<enscript highlight="scheme">
(nest '_ (1 2 _) (3 _ 5) (_) 4) ; => '(1 2 (3 (4) 5))
</enscript>

{{nest}} can also safely include special forms like {{if}}, {{let}},
{{lambda}}, or {{parameterize}} in a pipeline.

A custom placeholder can be used to safely nest nest expressions.

<enscript highlight="scheme">
(nest (nest _2 '_2 (1 2 3 _2) _ 6)
      (_ 5 _2)
      4)
; => '(1 2 3 (4 5 6))
</enscript>

==== nest-reverse

<procedure>(nest-reverse <initial-value> [<placeholder>] <step> ...)</procedure>

nest-reverse is variant of nest that nests in reverse order, which is the same
order as chain.

{{<initial-value>}} is an expression. {{<placeholder>}} is a literal symbol;
this is the placeholder symbol. If {{<placeholder>}} is not present, the
placeholder symbol is {{_}}.

The syntax of {{<step>}} is {{(<datum> ... <_> <datum> ...)}}, where {{<_>}} is
the placeholder symbol.

<enscript highlight="scheme">
(nest-reverse e (c d _) (a b _)) ; => (a b (c d e))
</enscript>

A nest-reverse expression is evaluated by lexically replacing the {{<_>}} in
the first {{<step>}} with {{<initial-value>}}, then replacing the {{<_>}} in
the second {{<step>}} with that replacement, and so on until the {{<_>}} in the
last {{<step>}} has been replaced. It is an error if the resulting final
replacement is not an expression, which is then evaluated and its values are
returned.

=== Author

Adam Nelson

=== Maintainer

[[diego-mundo|Diego A. Mundo]]

Ported to CHICKEN 5 by Sergey Goldgaber

=== Repository

[[https://code.dieggsy.com/srfi-197|https://code.dieggsy.com/srfi-197]]

=== License

 © 2020 Adam Nelson.
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal
 in the Software without restriction, including without limitation the rights
 to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the Software is
 furnished to do so, subject to the following conditions:
 
 The above copyright notice and this permission notice (including the next
 paragraph) shall be included in all copies or substantial portions of the
 Software.
 
 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 SOFTWARE.

=== Version history

; 0.1 : Ported to CHICKEN 5


D srfi-64-minimal.scm => srfi-64-minimal.scm +0 -45
@@ 1,45 0,0 @@
; Just enough of SRFI 64 (unit tests) to run test.scm.

(define *test-failures* '())

(define (test-begin name)
  (newline)
  (display "Test group: ")
  (display name)
  (newline)
  (newline))

(define (test-end name)
  (newline)
  (cond
    ((null? *test-failures*)
      (display "All tests passed!")
      (newline)
      (newline)
      (exit 0))
    (else
      (write (length *test-failures*))
      (display " TEST(S) FAILED:")
      (newline)
      (for-each (lambda (x) (x)) (reverse *test-failures*))
      (newline)
      (exit 1))))

(define (test-equal name expected actual)
  (cond
    ((equal? expected actual)
      (display "PASS: "))
    (else
      (set! *test-failures*
            (cons
              (lambda ()
                (display name)
                (display ": Expected ")
                (write expected)
                (display ", got ")
                (write actual)
                (newline))
              *test-failures*))
      (display "FAIL: ")))
  (display name)
  (newline))


M tests/run.scm => tests/run.scm +211 -5
@@ 1,6 1,212 @@
(import (scheme base)
        (scheme process-context)
        (scheme write)
        (srfi-197))
(import srfi-197
        test)

(include "./test.scm")
(define (exclamation x) (string-append x "!"))

(define (foo+bar x) (values (string-append x "foo") (string-append x "bar")))

(test-begin "Pipeline Operators")

(test "chain" "bazbarfoo!"
      (chain ""
             (string-append "foo" _)
             (string-append "bar" _)
             (string-append "baz" _)
             (exclamation _)))

(test "chain with mixed _ position" "barfoobaz"
      (chain ""
             (string-append _ "foo")
             (string-append "bar" _)
             (string-append _ "baz")))

(test "chain with _ in operator position" 3
      (chain +
             (_ 1 2)))

(test "chain without _" "barbazqux"
      (chain ""
             (string-append _ "foo")
             (string-append "bar" "baz")
             (string-append _ "qux")))

(test "chain multiple _" "quxfoo/quxbar"
      (chain "qux"
             (foo+bar _)
             (string-append _ "/" _)))

(test "chain _ ..." "bazquxfooquxbar"
      (chain "qux"
             (foo+bar _)
             (string-append "baz" _ ...)))

(test "chain _ _ ..." "quxfoobazquxbar"
      (chain "qux"
             (foo+bar _)
             (string-append _ "baz" _ ...)))

(test "chain with custom _" "bazbarfoo!"
      (chain "" <>
             (string-append "foo" <>)
             (string-append "bar" <>)
             (string-append "baz" <>)
             (exclamation <>)))

(test "chain with custom ..." "bazquxfooquxbar"
      (chain "qux" - ---
             (foo+bar -)
             (string-append "baz" - ---)))

(test "chain-and" "bazbarfoo!"
      (chain-and ""
                 (string-append "foo" _)
                 (string-append "bar" _)
                 (string-append "baz" _)
                 (exclamation _)))

(test "chain-and with mixed _ position" "barfoobaz"
      (chain-and ""
                 (string-append _ "foo")
                 (string-append "bar" _)
                 (string-append _ "baz")))

(test "chain-and without _" "barbazqux"
      (chain-and ""
                 (string-append "foo" _)
                 (string-append "bar" "baz")
                 (string-append _ "qux")))

(test "chain-and short-circuit" #f
      (chain-and ""
                 (string-append "foo" _)
                 (equal? _ "bar")
                 (string-append "baz" _)
                 (exclamation _)))

(test "chain-and short-circuit first" #f
      (chain-and #f
                 (not _)))

(test "chain-and with custom _" "bazbarfoo!"
      (chain-and "" <>
                 (string-append "foo" <>)
                 (string-append "bar" <>)
                 (string-append "baz" <>)
                 (exclamation <>)))

(test "chain-when" "bazfoo"
      (chain-when ""
                  ((= (+ 2 2) 4) (string-append "foo" _))
                  ((= (+ 2 2) 5) (string-append "bar" _))
                  (#t (string-append "baz" _))))

(test "chain-when with mixed _ position" "barfooqux"
      (chain-when ""
                  (#t (string-append _ "foo"))
                  (#t (string-append "bar" _))
                  (#f (string-append _ "baz"))
                  (#t (string-append _ "qux"))))

(test "chain-when without _" "barqux"
      (chain-when ""
                  (#t (string-append _ "foo"))
                  (#t (string-append "bar"))
                  (#f (string-append _ "baz"))
                  (#t (string-append _ "qux"))))

(test "chain-when with custom _" "bazfoo"
      (chain-when "" <>
                  ((= (+ 2 2) 4) (string-append "foo" <>))
                  ((= (+ 2 2) 5) (string-append "bar" <>))
                  (#t (string-append "baz" <>))))

(test "chain-lambda" "bazbarfoo!"
      ((chain-lambda (string-append "foo" _)
                     (string-append "bar" _)
                     (string-append "baz" _)
                     (exclamation _))
       ""))

(test "chain-lambda one step" "foobar"
      ((chain-lambda (string-append "foo" _)) "bar"))

(test "chain-lambda with mixed _ position" "barfoobaz"
      ((chain-lambda (string-append _ "foo")
                     (string-append "bar" _)
                     (string-append _ "baz"))
       ""))

(test "chain-lambda multiple _" "foobarbazqux"
      ((chain-lambda (string-append _ "bar" _)
                     (string-append _ "qux"))
       "foo"
       "baz"))

(test "chain-lambda without _" "barqux"
      ((chain-lambda (string-append "bar")
                     (string-append _ "qux"))))

(test "chain-lambda _ ..." "foobarbazqux"
      ((chain-lambda (string-append "foo" _ ...)
                     (string-append _ "qux"))
       "bar"
       "baz"))

(test "chain-lambda _ _ ..." "foobarbazquxquux"
      ((chain-lambda (string-append _ "bar" _ ...)
                     (string-append _ "quux"))
       "foo"
       "baz"
       "qux"))

(test "chain-lambda with custom _" "bazbarfoo!"
      ((chain-lambda <>
                     (string-append "foo" <>)
                     (string-append "bar" <>)
                     (string-append "baz" <>)
                     (exclamation <>))
       ""))

(test "chain-lambda with custom ..." "foobarbazqux"
      ((chain-lambda - ---
                     (string-append "foo" - ---)
                     (string-append - "qux"))
       "bar"
       "baz"))

(test "nest" '(1 2 (3 (4) 5))
      (nest (quote _)
            (1 2 _)
            (3 _ 5)
            (_)
            4))

(test "nest with custom _" '(1 2 (3 (4) 5))
      (nest <>
            (quote <>)
            (1 2 <>)
            (3 <> 5)
            (<>)
            4))

(test "nested nest" '(1 2 3 (4 5 6))
      (nest (nest _2 (quote _2) (1 2 3 _2) _ 6)
            (_ 5 _2)
            4))

(test "nest-reverse" '(1 2 (3 (4) 5))
      (nest-reverse 4
                    (_)
                    (3 _ 5)
                    (1 2 _)
                    (quote _)))

(test "nest-reverse with custom _" '(1 2 (3 (4) 5))
      (nest-reverse 4 <>
                    (<>)
                    (3 <> 5)
                    (1 2 <>)
                    (quote <>)))

(test-end "Pipeline Operators")
(test-exit)