Welcome to the CHICKEN Scheme pasting service
Simple threading macros pasted by dzoe on Thu Oct 12 10:04:56 2023
(module threading2 (~> ~>>) (import scheme) ;; Evaluates to T if given list of arguments contians placeholder _ - ;; if it doesn't, evaluates to F. (define-syntax if-has-placeholder? (syntax-rules (_) ((_ T F) F) ((_ T F _ arg ...) T) ((_ T F arg0 arg ...) (if-has-placeholder? T F arg ...)))) ;; Emplaces given argument at placeholder position (define-syntax place-argument (syntax-rules (_) ((_ step0 val () (rargs ...)) (step0 rargs ...)) ((_ step0 val (_ args ...) (rargs ...)) (place-argument step0 val (args ...) (rargs ... val))) ((_ step0 val (arg0 args ...) (rargs ...)) (place-argument step0 val (args ...) (rargs ... arg0))))) ;; Expands both left and right threading forms (define-syntax thexpander1 (syntax-rules (~> ~>>) ((_ (r? v) ()) v) ((_ (r? v) ((~> step^ ...) step ...)) ((lambda (v^) (thexpander0 (#f v^) (step^ ...) ())) (thexpander1 (r? v) (step ...)))) ((_ (r? v) ((~>> step^ ...) step ...)) ((lambda (v^) (thexpander0 (#t v^) (step^ ...) ())) (thexpander1 (r? v) (step ...)))) ((_ (#f v) ((step0 arg ...) step ...)) (if-has-placeholder? (place-argument step0 (thexpander1 (#f v) (step ...)) (arg ...) ()) (step0 (thexpander1 (#f v) (step ...)) arg ...) arg ...)) ((_ (#t v) ((step0 arg ...) step ...)) (if-has-placeholder? (place-argument step0 (thexpander1 (#f v) (step ...)) (arg ...) ()) (step0 arg ... (thexpander1 (#f v) (step ...))) arg ...)) ((_ (r? v) (step0 step ...)) (step0 (thexpander1 (r? v) (step ...)))) )) ;; Inverts the steps for further processing (define-syntax thexpander0 (syntax-rules () ((_ aux () (rstep ...)) (thexpander1 aux (rstep ...))) ((_ aux (step0 step ...) (rstep ...)) (thexpander0 aux (step ...) (step0 rstep ...))))) ;; Left threading (define-syntax ~> (syntax-rules () ((_ step0 step ...) (lambda (v) (thexpander0 (#f v) (step0 step ...) ()))))) ;; Right threading (define-syntax ~>> (syntax-rules () ((_ step0 step ...) (lambda (v) (thexpander0 (#t v) (step0 step ...) ()))))) ) (import threading2) (define (sqr v) (* v v)) (print ((~> add1 sqr (+ 10) (~> identity) (list 1 2 _ 3)) 1)) (print ((~> add1 (/ 2)) 11)) (print ((~>> add1 (/ 2)) 11))
syntax-rules ignores first pattern variable added by sjamaan on Thu Oct 12 10:13:46 2023
(define-syntax if-has-placeholder? (syntax-rules (_) ((x T F) F) ((x T F _ arg ...) T) ((x T F arg0 arg ...) (x T F arg ...)))) (if-has-placeholder? 1 2 _ 3) => 1 (if-has-placeholder? 1 2 3 4 _ 5) => Error: unbound variable: x