diff --git a/src/macro.c b/src/macro.c index 531ffb1f..57f79423 100644 --- a/src/macro.c +++ b/src/macro.c @@ -347,6 +347,9 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) /* defined symbol */ a = pic_car(pic, var); + if (! pic_symbol_p(a)) { + a = macroexpand(pic, a, senv); + } if (! pic_symbol_p(a)) { pic_error(pic, "binding to non-symbol object"); } @@ -364,6 +367,9 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) return v; } + if (! pic_symbol_p(var)) { + var = macroexpand(pic, var, senv); + } if (! pic_symbol_p(var)) { pic_error(pic, "binding to non-symbol object"); } diff --git a/t/ir-macro.scm b/t/ir-macro.scm new file mode 100644 index 00000000..28d4985c --- /dev/null +++ b/t/ir-macro.scm @@ -0,0 +1,61 @@ +(define-syntax aif + (ir-macro-transformer + (lambda (form inject cmp) + (let ((it (inject 'it)) + (expr (car (cdr form))) + (then (car (cdr (cdr form)))) + (else (car (cdr (cdr (cdr form)))))) + `(let ((,it ,expr)) + (if ,it ,then ,else)))))) + +(aif (member 'b '(a b c)) (car it) #f) + +;;; test hygiene begin + +(define-syntax mif + (ir-macro-transformer + (lambda (form inject cmp) + (let ((expr (car (cdr form))) + (then (car (cdr (cdr form)))) + (else (car (cdr (cdr (cdr form)))))) + `(let ((it ,expr)) + (if it ,then ,else)))))) + +(let ((if 42)) + (mif 1 2 3)) +; => 2 + +(let ((it 42)) + (mif 1 it 2)) +; => 42 + +;;; end + + + +;;; test core syntax begin + +(mif 'a 'b 'c) +; => b + +(define-syntax loop + (ir-macro-transformer + (lambda (expr inject cmp) + (let ((body (cdr expr))) + `(call-with-current-continuation + (lambda (,(inject 'exit)) + (let f () + ,@body (f)))))))) + +(define a 1) +(loop + (if (= a 2) (exit #f)) + (set! a 2)) +; => #f + +(loop + (define a 1) + (if (= a 1) (exit #f))) +; => #f + +;;; end