I think the double assignment of the names given to the labels macro is needed in the case that the functions call each other. Take this example:
(labels ((even (n)
(if (is n 0)
'even
(odd (- n 1))))
(odd (n)
(if (is n 0)
'odd
(even (- n 1)))))
(even 5))
The macroexpansion of this labels call looks like this
((fn (g3947 g3948)
(with (even (fn a (apply g3947 a))
odd (fn a (apply g3948 a)))
(with (even (fn (n) (if (is n 0) (quote even) (odd (- n 1))))
odd (fn (n) (if (is n 0) (quote odd) (even (- n 1)))))
(do
(= g3947 even)
(= g3948 odd))
(even 5))))
(fn nil nil) (fn nil nil))
If I add a prn to see what we get, we can run the code and see that it works as expected.
(prn ((fn (g3947 g3948)
(with (even (fn a (apply g3947 a))
odd (fn a (apply g3948 a)))
(with (even (fn (n) (if (is n 0) (quote even) (odd (- n 1))))
odd (fn (n) (if (is n 0) (quote odd) (even (- n 1)))))
(do
(= g3947 even)
(= g3948 odd))
(even 5))))
(fn nil nil) (fn nil nil)))
;; odd
Now I will remove the outer with and run the same code, which returns nil.
(prn ((fn (g3947 g3948)
(with (even (fn (n) (if (is n 0) (quote even) (odd (- n 1))))
odd (fn (n) (if (is n 0) (quote odd) (even (- n 1)))))
(do
(= g3947 even)
(= g3948 odd))
(even 5)))
(fn nil nil) (fn nil nil)))
;; nil
I can't explain this in greater detail; I haven't traced the full execution. But given the evidence I believe mutual recursion makes double assignment necessary.
Yes, this simpler macroexpansion is all that's needed, apparently. When I first ported the code above I didn't have an appreciation for what labels needed to do; I just ported it. Thanks for making me think about it a little harder. Here is an implementation that will macroexpand to only one with. I've included a sample macroexpansion, as well as the results of running two functions. One of them, (collatz-seq), uses only simple recursion. The other, (parity), uses mutual recursion.
(mac labels (fns . forms)
(with (fnames (map car fns)
fbodies (map (fn (f) `(fn ,@(cdr f))) fns))
`(with ,(mappend (fn (name) `(,name nil)) fnames)
(= ,@(mappend (fn (f) `(,(car f) ,@(cdr f)))
(zip fnames fbodies)))
,@forms)))
(def collatz-seq (n)
(labels ((collatz (n)
(if (even n)
(/ n 2)
(+ (* n 3) 1)))
(worker (n seq)
(if (is n 1)
(cons n seq)
(worker (collatz n) (cons n seq)))))
(rev (worker n '()))))
(def parity (n)
(labels ((even (n)
(if (is n 0)
'even
(odd (- n 1))))
(odd (n)
(if (is n 0)
'odd
(even (- n 1)))))
(even n)))
(prn (macex1 '(labels ((even (n)
(if (is n 0)
'even
(odd (- n 1))))
(odd (n)
(if (is n 0)
'odd
(even (- n 1)))))
(even n))))
(prn (parity 17))
(prn (parity 24))
(prn (collatz-seq 21))
;; ---------------------------------------------
;; (with (even nil odd nil)
;; (= even (fn (n)
;; (if (is n 0)
;; (quote even)
;; (odd (- n 1))))
;; odd (fn (n)
;; (if (is n 0)
;; (quote odd)
;; (even (- n 1)))))
;; (even n))
;;
;; odd
;; even
;; (21 64 32 16 8 4 2 1)
Got the CL version from here http://www.pipeline.com/~hbaker1/MetaCircular.html. Someone on ##lisp IRC linked me when I was asking about how to write labels. Since I'm curious too, I'll do a similar analysis on CL and post the results.
By the way, I was sad that you stopped submitting Tcl links after the one :) Don't be discouraged that there was no discussion on it. Sometimes I can't think of anything to say at the moment, but I still enjoy the link.
Since I'm on a roll here with my speculatin': also don't correlate how a post is received with how long it takes to get comments. I just didn't see your Y-combinator post for the 8 days before I responded. Which is a complete outlier for me on this Forum and hopefully not a harbinger of things to come.. :/