Arc Forum | Labels macro in arc

Arc Forum

Labels macro in arc

4 points by mpr 3004 days ago | 10 comments

I've been meaning to write this up for a while, putting together some examples of how this is useful. But each time I go to think about it, I second guess myself as to whether this brings anything new to arc. Do we already have mutually recursive local functions? In any case, here is the labels macro ported to arc from common lisp. I'd appreciate comments on whether or not we can already do everything offered by labels.

    (def caddr (x)
      (car (cdr (cdr x))))

    (def flet2fn (flet)
      (with (name (car flet)
             args (cadr flet)
             body (caddr flet))
        `(,name (fn ,args ,body))))

    (mac labels (fns . forms)
      (withs (fnames (map car fns)
              nfnames (map [uniq] fnames)
              nfbodies (map (fn (f) `(fn ,@(cdr f))) fns))
        `(with ,(mappend (fn (nf) `(,nf (fn () ()))) nfnames)
           (with ,(mappend (fn (f nf) `(,f (fn a (apply ,nf a))))
                       fnames nfnames)
             (with ,(mappend flet2fn fns)
               (do ,@(map (fn (f nf) `(= ,nf ,f))
                          fnames nfnames))
               ,@forms)))))

I grabbed the common lisp implementation from here: http://www.pipeline.com/~hbaker1/MetaCircular.html

Example usage:

    (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 '()))))

    (collatz-seq 10)

    ;; mpr@mpr:~/src/arc$ arc collatz.arc
    ;; (10 5 16 8 4 2 1)
    ;; #t

2 points by akkartik 3003 days ago | link

I could swear we discussed this before, and that I had picked out a solution to my satisfaction, but I can't for the life of me recall it. Hopefully someone else will. Yours is certainly a contender.

It's not clear how your macro works, though. When I expand the above call to labels I get this:

  (with (g20467 (fn nil nil)
         g20468 (fn nil nil))
    (with (collatz (fn a (apply g20467 a))
           worker  (fn a (apply g20468 a)))
      (with (collatz (fn (n) (if (even n) (/ n 2) (+ (* n 3) 1)))
             worker  (fn (n seq)
                       (if (is n 1)
                         (cons n seq)
                         (worker (collatz n) (cons n seq)))))
        (do (= g20467 collatz) (= g20468 worker))
        (rev (worker n 'nil)))))

Is there a reason you need two nested with forms defining 'collatz and 'worker?

-----

3 points by mpr 3003 days ago | link

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.

-----

4 points by akkartik 3003 days ago | link

You could macroexpand to this, though:

  (with (even nil odd nil)
    (= even (fn (n)
              (if (is n 0)
                'even
                (odd (- n 1))))
       odd  (fn (n)
              (if (is n 0)
                'odd
                (even (- n 1)))))
    (even 5))

-----

3 points by mpr 3003 days ago | link

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)

-----

3 points by akkartik 3003 days ago | link

That's very interesting analysis. I'm curious to see where you got the original Common Lisp version from. Is there some reason CL requires two withs?

-----

3 points by mpr 3002 days ago | link

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.

-----

3 points by mpr 3003 days ago | link

Good point. Then I don't see any need for the double with.

-----

4 points by akkartik 3003 days ago | link

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.

-----

4 points by mpr 3003 days ago | link

Hah! Yes, I was a little discouraged. Thanks for letting me know! I have some stuff in mind, expect to see more soon :)

-----

3 points by akkartik 3003 days ago | 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.. :/

-----