(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))