guile-examples/macros/threading/threading-chain-pipe.scm

(library (threading-macro)
  (export ->)
  (import
    (except (rnrs base))
    (only (guile))))


;; The following macro was suggested by Mark H. Weaver on
;; the Guile Scheme user mailing list, as a response to a
;; different formulation of Chris Vine, also on the Guile
;; Scheme user mailing list, in the context of writing a
;; threading macro.

;; Comments added by me.

(define-syntax ->
  ;; We are not defining any literals.
  (syntax-rules ()
    ;; Base case. If there is only the initial expression,
    ;; it means, that no operations are applied, so the
    ;; expression is already the result of the pipe.
    [(-> exp) exp]
    ;; If there is an arbitrary number of expressions `exp
    ;; ...` followed by one final expression `(op args
    ;; ...)`, which consists of an operation `op` and an
    ;; arbitrary number of arguments `args ...` for that
    ;; operation, ...
    [(-> exp ... (op args ...))
     ;; ... we destrcuture the final operation into the
     ;; operation name `op` and its arguments `args
     ;; ...`. With that we are able to make it the
     ;; outer-most wrapping operation call in the syntax
     ;; produced by the macro. Furthermore we output a new
     ;; macro call, which is the same, except, that it is
     ;; wrapped inside the last operation and does not
     ;; contain the last operation any longer, reducing the
     ;; number of expressions in the macro call. When the
     ;; macro is called again, it will have another
     ;; expression as the final operation. This will
     ;; continue until all expressions have been wrapped as
     ;; procedure calls around the initial expression and
     ;; the macro will go into the base case.
     (op args ... (-> exp ...))]))

;; From this we can easily derive a version `pipe-left`,
;; which always puts the value of the previous pipe step on
;; the left, instead of the right of given arguments to the
;; operations as follows:

;; (define-syntax pipe-left
;;   (syntax-rules ()
;;     [(-> exp) exp]
;;     [(-> exp ... (op args ...))
;;      (op (-> exp ...) args ...)]))


;; (define-syntax ->
;;   (syntax-rules ()
;;     ((-> exp) exp)
;;     ((-> exp (proc args ...) rest ...) (-> (proc exp args ...) rest ...)
;;     ((-> exp proc rest ...) (-> (proc exp) rest ...))))