For Fun: Clojure-style Tail Recursion in newLISP

[rickyboy]

Today, I just read an http://www.mikeivanov.com/2010/08/tail-recursion-without-tco.html">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. [EDIT: I updated the code in the following block after my original posting to fix a bug.  The details of the bug (error) are described in a TL;DR reply of mine further down in this discussion.]

Code Select Expand

(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.

Code Select Expand

(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!

Code Select Expand

> (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.  Thanks and happy hacking! :)

[xytroxon]

Just noticed one small little thing ;o)



Variable names .args, .res, .parms, .etc. are "illegal" in newLISP due to the starting . (period) in their names.

Symbols for variable names



The following rules apply to the naming of symbols used as variables or functions:



1. Variable symbols may not start with any of the following characters:

# ; " ' ( ) { } . , 0 1 2 3 4 5 6 7 8 9

-- xytroxon

[cormullion]

but then

Code Select Expand

> (set '.x '(1 2 3))
(1 2 3)
> .x
(1 2 3)


[rickyboy]

but then

Code Select Expand

> (set '.x '(1 2 3))
(1 2 3)
> .x
(1 2 3)

Exactly!  Also

Code Select Expand

>
(if (find '.x (symbols))
   "It's in the symbol table, Hoss!"
   "What you tried to do is ILLEGAL! Please slowly step away from the keyboard!")

"It's in the symbol table, Hoss!"
>
:)

[Lutz]

Sometimes it's fun to do something illegal - in programming languages, I mean  - (1)

Code Select Expand


> (legal? "(:-) . { }")
nil
> (set (sym "(:-) . { }") 123)
123
> (eval (sym "(:-) . { }"))
123
>


legal? can be useful when creating symbols during run-time



(1) I know, some on this forum work for the government ;)

[rickyboy]

There was an error in my first implementation of the loop macro in extracting the "variables" associated with the loop bindings.  I changed this in the first post (above), in case any reader gets TL;DR-itis and doesn't make it this far into the discussion.



newLISP Let Bindings



Before we get into describing the error, I should give some context.



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.

Code Select Expand

> (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.

Code Select Expand

> (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.

Code Select Expand

> (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 Error



So now on to how the error was introduced.  I knew my code needed to build a list of "parameters" from the bindings provided by the user (caller) of loop.  These parameters are a list of all the variables in the loop bindings, and the loop macro was going to use these in building its call to loop-.  This list is the second argument to loop-, by the way.



I had thought that the users of loop would naturally need to express the loop bindings in the same way that they express any let bindings that they ever code.  So, in building that list of parameters, I had to be mindful of the different ways that let bindings can be expressed in newLISP (as we covered above).



The error is contained in the following (original and erroneous) definition of loop.  You might be able to spot it right away.

Code Select Expand

(define-macro (loop INIT)
  (letn (.parms (map first (explode (flat INIT) 2))
         .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]))))
Specifically the error is in the way the parameters, .parms, are getting computed by the expression (map first (explode (flat INIT) 2)).  The problem is that flat flattens the list "too deeply" for our use.



For instance, the first usage is OK, but the second breaks.

Code Select Expand

> (let (INIT '(x 1 y 2 z 3)) (map first (explode (flat INIT) 2)))
(x y z)
> (let (INIT '(x 1 y (+ 40 2) z 3)) (map first (explode (flat INIT) 2)))
(x y 40 z)
Oops, look at the second usage above: 40 is not supposed to be a parameter.  The second usage breaks because flat is "too eager" or "too deep."  Let's look at what flat does to the bindings from the second usage above.

Code Select Expand

> (let (INIT '(x 1 y (+ 40 2) z 3)) (flat INIT))
(x 1 y + 40 2 z 3)
Yeah, that's not what we want.  What we need, however, is a "shallower" version of flat.



The following function flat-shallow-pairs attempts to do just that.  It will flatten a list, making "flat pairs" along the way, but will respect the pairs that are explicitly expressed with parentheses.

Code Select Expand

(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))
Here it is in action on the (formerly problematic) second usage and beyond.

Code Select Expand

> (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)))
Now, we just replace flat with flat-shallow-pairs in the expression (map first (explode (flat INIT) 2)), but we'll roll that expression into a function called parms<-bindings.

Code Select Expand

(define (parms<-bindings BINDINGS)
  (map first (explode (flat-shallow-pairs BINDINGS) 2)))
Let's look at the old and new computation, side-by-side.

Code Select Expand

> (let (INIT '(x 1 y (+ 40 2) z 3)) (map first (explode (flat INIT) 2)))
(x y 40 z)
> (let (INIT '(x 1 y (+ 40 2) z 3)) (parms<-bindings INIT))
(x y z)

So, the new definition of loop is now the following.

Code Select Expand

(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]))))
As before, please let me know about any errors or if things can be accomplished better.  Thanks!

[xytroxon]

Sometimes it's fun to do something illegal - in programming languages, I mean  - (1)

(1) I know, some on this forum work for the government ;)

And sometimes it's not... when it allows easily made programming errors...

Code Select Expand



(setq x -0.1)
(println (inc x)) ;-> 0.9
(println (inc x)) ;-> 1.9
(println (inc x)) ;-> 2.9

(setq x -.1)
(println (inc x)) ;-> 1
(println (inc x)) ;-> 2
(println (inc x)) ;-> 3

(println -.1) ;-> nil

(exit)


(1+) Busted! Do not pass Go! Do not collect 200 dollars! Go directly to broken code jail! ;o)



-- xytroxon

[Lutz]

Ouch! But now fixed:

Code Select Expand


> (setq x -.1)
-0.1
> (inc x)
0.9
> (inc x)
1.9
> (inc x)
2.9
> -.9e10
-9000000000
>


and this for rickyboy:

Code Select Expand


(flat '(a b (c d (e f)) (g h (i j))) )   → (a b c d e f g h i j)

(flat '(a b (c d (e f)) (g h (i j))) 1)  → (a b c d (e f) g h (i j))

(flat '(a b (c d (e f)) (g h (i j))) 2)  → (a b c d e f g h i j)


new optional parameter for recursion level in flat

[rickyboy]

Thanks, Lutz!  You've always been great to us.  You must have boundless energy due to all the good coffee you drink. :)  Gracias por todo!

[cormullion]

I preferred:

Code Select Expand

> (set '-.1 2)
2

:)