From d9398828c016805352efde34db01eb31a23c7971 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Tue, 3 Dec 2013 13:09:38 +0900 Subject: [PATCH] ir-macro-transformer was broken --- piclib/built-in.scm | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) 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))))))