Clojure-style Tail Recursion in newLISP

rick, 2013-04-04

Today, I just read an old blog post by Mike Ivanov where he explains how he implemented Clojure-style (loop/recur) tail recursion in Emacs Lisp. My first thought was, “Hey, that’s cool!” My second thought was, “Hey, I think we can do this in newLISP too!” :)

So, just for fun, here is my newLISP port of Mike’s implementation.

(constant '[loop/recur-marker] '[loop/recur-marker])

(define (loop- BODY-FN)
  (let (.args (args) .res nil)
    (while (begin
             (setq .res (apply BODY-FN .args))
             (when (and (list? .res) (not (empty? .res))
                        (= [loop/recur-marker] (first .res)))
               (setq .args (rest .res)))))
    .res))

(define (recur) (cons [loop/recur-marker] (args)))

(define (flat-shallow-pairs LIST)
  (let (i 0 acc '())
    (dolist (e LIST)
      (cond ((even? i) ; Indicator i is even = abscissa
             (cond ((and (list? e) (not (empty? e)))
                    (extend acc (0 2 (push nil e -1))))
                   ((symbol? e)
                    (push e acc -1)
                    (inc i))))
            ((odd? i) ; Indicator i is odd = ordinate
             (push e acc -1)
             (inc i))))
    acc))

(define (parms<-bindings BINDINGS)
  (map first (explode (flat-shallow-pairs BINDINGS) 2)))

(define-macro (loop INIT)
  (letn (.parms (parms<-bindings INIT)
         .body-fn (letex ([body] (args)
                          [parms] .parms)
                    (append '(fn [parms]) '[body]))
         .loop-call (letex ([body-fn] .body-fn
                            [parms] .parms)
                      (append '(loop- [body-fn]) '[parms])))
    (letex ([init] INIT [loop-call] .loop-call)
      (letn [init] [loop-call]))))

You can’t use Mike’s (Emacs Lisp) applications examples verbatim, but here they are in newLISP.

(define (factorial x)
  (loop (x x acc 1)
    (if (< x 1)
        acc
        (recur (- x 1) (* x acc)))))

(define (fibo x)
  (loop (x x curr 0 next 1)
    (if (= x 0)
        curr
        (recur (- x 1) next (+ curr next)))))

They work like a charm!

> (factorial 10)
3628800
> (fibo 10)
55

Please let me know if you spot an error or if it can be accomplished better in any way. Happy hacking!

Addendum

You might be asking yourself, “what’s up with this flat-shallow-pairs function?” Well, here’s the backgrounder on that.

newLISP does something very cool with let bindings. In newLISP, you can code the let bindings as a list of pairs – as it is done in Common Lisp or Scheme, for example – as in the following.

> (let ((x 1) (y 2) (z 3)) (list x y z))
(1 2 3)

Alternatively, newLISP allows you to drop the pair parentheses in the let bindings, or to mix and match.

> (let (x 1 y 2 z 3) (list x y z))
(1 2 3)
> (let (x 1 (y 2) z 3) (list x y z))
(1 2 3)

Also, note how the following bindings are equivalent.

> (let (x 1 (y) z 3) (list x y z))
(1 nil 3)
> (let (x 1 (y nil) z 3) (list x y z))
(1 nil 3)

The function flat-shallow-pairs returns the bindings expressed by the user in any case we’ve just described. Here it is in action.

> (let (INIT '(x 1 y (+ 40 2) z 3)) (flat-shallow-pairs INIT))
(x 1 y (+ 40 2) z 3)
> (let (INIT '((x 1) y (+ 40 2) z 3)) (flat-shallow-pairs INIT))
(x 1 y (+ 40 2) z 3)
> (let (INIT '((x 1) y (+ 40 2) z (lambda (x) (flat x)))) (flat-shallow-pairs INIT))
(x 1 y (+ 40 2) z (lambda (x) (flat x)))