Scheme section sequence macros (aka threading macros in clojure) with haskell-style 'where clause

example.scm

(define (hex->dec str)
  (>> (string-fold add-next 0 str)
      :where  ; deferred declaration of local bindings
      (char-values (map cons (string->list "0123456789abcdef") (iota 16)))
      #((add-next digit acc)  ; lambda binding shorthand in :where clause
        (>> (assv-ref char-values digit)
            (or (error "invalid hex digit" digit str))
            (+ (* 16 acc))))))

(define (dec->hex num)
  (>> "0123456789abcdef"
      #(lambda (i) (string-ref _ i))  ; arbitrary section. binds the last value to '_
      :as n->char  ; rename the implicit var for the next arb section
      #(let loop ((n num) (hex '()))
         (if (< n 16)
           (>> (n->char n) (cons hex) (list->string))  ; implicit var can be used many times anywhere
           (loop (quotient n 16)                       ; in the form, even in the function position
                 (>> n (remainder 16) (n->char) (cons hex)))))))

(define (main args)
  (>> :as %  ; name the implicit var in all arb sections as '% unless overridden
      args
      #(if (and (pair? %) (pair? (cdr %)))
         (cadr %)
         (die "give me a hex string!"))
      (string-downcase)
      (hex->dec)
      :do  ; keep the current value after the next arb section returns
      #(println %)
      (dec->hex)
      (println)
      (false-if-exception)
      (or (die "what you gave me probably isn't a hex string."))
      :where
      #((println it)
        (display it)
        (newline))
      #((die msg)
        (println msg)
        (primitive-exit 1))))

section-dsl.scm

(define-syntax >>
  (lambda (x)
    (make-pipe x (lambda (inner outer args)
                   #`(#,outer #,inner . #,args)))))

(define-syntax <<
  (lambda (x)
    (make-pipe x (lambda (inner outer args)
                   #`(#,outer #,@args #,inner)))))

(define (make-pipe root wrap)
  (define default-it (datum->syntax root '_))
  (define (loop inner rest it peek)
    (if (null? rest)
      inner
      (syntax-case rest (:where :as :do)
        (((outer args ...) _ ...)
         (loop (wrap inner #'outer #'(args ...))
               (cdr rest)
               it peek))
        (((h . t) _ ...)
         #'(syntax-error "invalid section; must be a proper list" (h . t)))
        ((:do _ ...)
         (loop inner (cdr rest) it #t))
        ((:as symbol _ ...)
         (identifier? #'symbol)
         (loop inner (cddr rest) #'symbol peek))
        ((:as _ ...)
         #'(syntax-error ":as must be followed by an identifier"))
        ((#(body body* ...) _ ...)
         (loop #`(let ((#,it #,inner))
                   #,@(cons #'(body body* ...) (if peek (list it) '())))
               (cdr rest)
               default-it #f))
        ((:where bindings ...)
         (where #'(bindings ...) inner))
        (e #'(syntax-error
               "invalid section; must be a list or a code vector"
               e)))))
  (syntax-case root (:as)
    ((_ :as symbol start next ...)
     (identifier? #'symbol)
     (begin
       (set! default-it #'symbol)
       (loop #'start #'(next ...) #'symbol #f)))
    ((_ :as _ ...)
     #'(syntax-error ":as must be followed by an identifier"))
    ((_ start next ...)
     (loop #'start #'(next ...) default-it #f))))

(define (where bindings e)
  (syntax-case bindings ()
    (() e)
    (_ (let loop ((vars '()) (rest bindings))
         (syntax-case rest ()
           (((var val) _ ...)
            (identifier? #'var)
            (loop #`(#,@vars (var val))
                  (cdr rest)))
           (((h . t) . _)
            #'(syntax-error
                "invalid binding; must be a 2-elem list and start with an identifier"
                (h . t)))
           ((#((fun . args) body body* ...) _ ...)
            (identifier? #'fun)
            (loop #`(#,@vars (fun (lambda args body body* ...)))
                  (cdr rest)))
           (()
            #`(letrec #,vars #,e))
           ((e _ ...)
            #'(syntax-error
                "invalid form in :where clause; must be a binding or a shorthand named function"
                e)))))))