diff --git a/piclib/built-in.scm b/piclib/built-in.scm index f884c106..6f6ee163 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -600,10 +600,23 @@ (identifier=? use-env x use-env y)) (make-syntactic-closure use-env '() (f expr rename compare)))) +(define (acons key val alist) + (cons (cons key val) alist)) + (define (ir-macro-transformer f) (lambda (expr use-env mac-env) - (define (inject identifier) - (make-syntactic-closure use-env '() identifier)) - (define (compare x y) - (identifier=? use-env x use-env y)) - (make-syntactic-closure mac-env '() (f (walk inject expr) inject compare)))) + (let ((wrapped '())) + (define (inject obj) + (let ((s (make-syntactic-closure use-env '() obj))) + (set! wrapped (acons s obj wrapped)) + s)) + (define (extract obj) + (let ((t (assq obj wrapped))) + (if t (cdr t) obj))) + (define (wrap expr) + (walk inject expr)) + (define (unwrap expr) + (walk extract expr)) + (define (compare x y) + (identifier=? use-env x use-env y)) + (make-syntactic-closure mac-env '() (unwrap (f (wrap expr) inject compare))))))