Skip to content

Instantly share code, notes, and snippets.

@sumerman
Created October 10, 2012 12:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save sumerman/3865224 to your computer and use it in GitHub Desktop.
Save sumerman/3865224 to your computer and use it in GitHub Desktop.
Scheme macro WTF

Пытаюсь написать макрос переписывающий

(class (my-class x1 x2) 
  (method (my-method a) (+ a (self 'x2)))
  (method (x2)          x2))

в то, что написано в target.scm

Однако он почему-то себя рекурсивно не вызывает, только вставляет вызов my-class-expanded.scm, хотя та часть, которая должна переписать методы правильно работает "в вакууме" rmethods-expanded.scm

(define-syntax class
(syntax-rules (extends rmethods method)
((_ rmethods () r) `r)
((_ rmethods ((method (name arg1 ...) body ...) . methods) r)
(class rmethods methods ((name . ,(lambda (self arg1 ...) body ...)) . r)))
((_ header (extends parent) body ...)
(define header
(define methods (class rmethods (body ...) ()))
(make-dispatcher-self (extends (make-dict methods) parent))))
((_ header body ...)
(define header
(define methods (class rmethods (body ...) ()))
(make-dispatcher-self (make-dict methods))))))
(class (my-class x1 x2)
(method (my-method a) (+ a (self 'x2)))
(method (x2) x2))
(class rmethods
((method (my-method a) (+ a (self 'x2)))
(method (x2) x2)) ())
(define (my-class x1 x2)
(define methods
(class rmethods ((method (my-method a) (+ a (self 'x2))) (method (x2) x2)) ()))
(make-dispatcher-self (make-dict methods)))
(quasiquote
((x2 . ,(lambda (self) x2)) (my-method . ,(lambda (self a) (+ a (self 'x2))))))
(define (my-class x1 x2)
(define methods
`((x2 . ,(lambda (self) x2))
(my-method . ,(lambda (self a) (+ a (self 'x2))))))
(make-dispatcher-self (make-dict methods)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment