ck-macro-example.scm

;;'ck' procedure is copied from http://okmij.org/ftp/Scheme/macros.html#ck-macros
(define-syntax ck
 (syntax-rules (quote)
   ((ck () 'v) v)                      ; yield the value on empty stack

   ((ck (((op ...) ea ...) . s) 'v)    ; re-focus on the other argument, ea
    (ck s "arg" (op ... 'v) ea ...))

   ((ck s "arg" (op va ...))           ; all arguments are evaluated,
    (op s va ...))                    ; do the redex

   ((ck s "arg" (op ...) 'v ea1 ...)   ; optimization when the first ea
    (ck s "arg" (op ... 'v) ea1 ...)) ; was already a value

   ((ck s "arg" (op ...) ea ea1 ...)   ; focus on ea, to evaluate it
    (ck (((op ...) ea1 ...) . s) ea))

   ((ck s (op ea ...))                 ; Focus: handle an application;
    (ck s "arg" (op) ea ...))         ; check if args are values
))

(define-syntax macro-reverse-ck
  (syntax-rules (quote)
    ((_ s '(x ...)) (macro-reverse-ck s "progress" (x ...) ()))
    ((_  s "progress" () (res ...)) (ck s '(res ...)))
    ((_ s "progress" (x rest ...) (res ...))
     (macro-reverse-ck s "progress" (rest ...) (x res ...)))))

(define-syntax macro-cons*-ck
  (syntax-rules (quote)
      ((_ s 'args ...) (macro-cons*-ck s "progress" (args ...) ()))
      ((_ s "progress" (arg) (res ...)) (ck s '(res ... . arg)))
      ((_ s "progress" (arg1 args2 ...) (res ...)) (macro-cons*-ck s "progress" (args2 ...) (res ... arg1)))))

(define-syntax reverse-lambda
  (syntax-rules ()
    ((_ (args ...) bodies ...)
     (ck () (macro-cons*-ck 'lambda
                            (macro-reverse-ck '(args ...))
                            (macro-reverse-ck '(bodies ...)))))))

(display ((reverse-lambda (a b) (display (list a b)) (newline) 'result) 1 2))
(newline)