arc> (macex-all '(fn (do re mi) (+ do re mi))) (fn ((fn () re mi)) (+ do re mi)) arc> (macex-all ''(do not expand this -- it is quoted)) (quote ((fn () not expand this -- it is quoted)))
(def imap (f xs) (when xs (if (acons xs) (cons (f (car xs)) (imap f (cdr xs))) (f xs)))) (def macex-all (expr) (zap macex expr) (check expr atom (case (car expr) quasiquote (list 'quasiquote ((afn (level x) (if (is level 0) (macex-all x) (caris x 'quasiquote) (list 'quasiquote (self (+ level 1) cadr.x)) (in acons&car.x 'unquote 'unquote-splicing) (list car.x (self (- level 1) cadr.x)) (check x atom (imap [self level _] x)))) 1 (cadr expr))) fn `(fn ,(cadr expr) ,@(imap macex-all (cddr expr))) quote expr (imap macex-all expr))))
arc> (macex-all '`(a . b)) Error: "Can't take car of b"
Also, a couple nitpicks about dec.
(macex-all body)
arc> (ppr:macex1 '(dec foo bar mac baz quux quack)) (do (fn () (sref sig 'quux 'baz) ((fn () (if (bound 'baz) ((fn () (disp "*** redefining " (stderr)) (disp 'baz (stderr)) (disp #\newline (stderr))))) (assign baz (annotate 'mac (fn quux quack)))))))t
(map1 macex-all body)
Finally, the pattern
(let result x ... stuff not involving x or result ... result)
(mac dec (obj type . body) (let oldtype (declare-obj-class* obj) (= (declare-obj-class* obj) type) (do1 (cons 'do (map1 macex-all body)) (= (declare-obj-class* obj) oldtype))))