ir-macro-transformer was broken

piclib/built-in.scm

@@ -583,9 +583,6 @@
       (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 (walk f obj)
   (if (pair? obj)
       (cons (walk f (car obj)) (walk f (cdr obj)))
@@ -595,21 +592,12 @@
 
 (define (ir-macro-transformer f)
   (lambda (expr use-env mac-env)
-    (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))))))
+    (define (inject identifier)
+      (make-syntactic-closure use-env '() identifier))
+    (define (compare x y)
+      (identifier=? mac-env x mac-env y))
+    (let ((expr (walk (lambda (x) (if (symbol? x) (inject x) x)) expr)))
+      (make-syntactic-closure mac-env '() (f expr inject compare)))))
 
 (define-syntax or
   (ir-macro-transformer

src/macro.c

@@ -153,6 +153,20 @@ pic_identifier_p(pic_value obj)
   return false;
 }
 
+static pic_value
+strip(pic_state *pic, pic_value expr)
+{
+  if (pic_sc_p(expr)) {
+    return strip(pic, pic_sc(expr)->expr);
+  }
+  else if (pic_pair_p(expr)) {
+    return pic_cons(pic,
+                    strip(pic, pic_car(pic, expr)),
+                    strip(pic, pic_cdr(pic, expr)));
+  }
+  return expr;
+}
+
 static void
 pic_defsyntax(pic_state *pic, const char *name, struct pic_proc *macro, struct pic_senv *mac_env)
 {
@@ -365,7 +379,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	pic_gc_protect(pic, v);
 	return v;
       case PIC_STX_QUOTE:
-	v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym), pic_cdr(pic, expr));
+	v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym), strip(pic, pic_cdr(pic, expr)));
 	pic_gc_arena_restore(pic, ai);
 	pic_gc_protect(pic, v);
 	return v;