Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
;;'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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment