For Fun: Clojure-style Tail Recursion in newLISP

Featuring the Dragonfly web framework
Locked
rickyboy
Posts: 607
Joined: Fri Apr 08, 2005 7:13 pm
Location: Front Royal, Virginia

For Fun: Clojure-style Tail Recursion in newLISP

Post by rickyboy »

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. [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 all

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

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

> (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! :)
Last edited by rickyboy on Thu Apr 04, 2013 6:20 pm, edited 1 time in total.
(λx. x x) (λx. x x)

xytroxon
Posts: 296
Joined: Tue Nov 06, 2007 3:59 pm
Contact:

Re: For Fun: Clojure-style Tail Recursion in newLISP

Post by 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
"Many computers can print only capital letters, so we shall not use lowercase letters."
-- Let's Talk Lisp (c) 1976

cormullion
Posts: 2038
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:

Re: For Fun: Clojure-style Tail Recursion in newLISP

Post by cormullion »

but then

Code: Select all

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

rickyboy
Posts: 607
Joined: Fri Apr 08, 2005 7:13 pm
Location: Front Royal, Virginia

Re: For Fun: Clojure-style Tail Recursion in newLISP

Post by rickyboy »

cormullion wrote:but then

Code: Select all

> (set '.x '(1 2 3))
(1 2 3)
> .x
(1 2 3)
Exactly! Also

Code: Select all

>
(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!"
>
:)
(λx. x x) (λx. x x)

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Re: For Fun: Clojure-style Tail Recursion in newLISP

Post by Lutz »

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

Code: Select all

> (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
Posts: 607
Joined: Fri Apr 08, 2005 7:13 pm
Location: Front Royal, Virginia

Re: For Fun: Clojure-style Tail Recursion in newLISP

Post by 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 all

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

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

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

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

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

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

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

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

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

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

(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!
(λx. x x) (λx. x x)

xytroxon
Posts: 296
Joined: Tue Nov 06, 2007 3:59 pm
Contact:

Re: For Fun: Clojure-style Tail Recursion in newLISP

Post by xytroxon »

Lutz wrote: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 all


(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
"Many computers can print only capital letters, so we shall not use lowercase letters."
-- Let's Talk Lisp (c) 1976

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Re: For Fun: Clojure-style Tail Recursion in newLISP

Post by Lutz »

Ouch! But now fixed:

Code: Select all

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

(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
Posts: 607
Joined: Fri Apr 08, 2005 7:13 pm
Location: Front Royal, Virginia

Re: For Fun: Clojure-style Tail Recursion in newLISP

Post by 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!
(λx. x x) (λx. x x)

cormullion
Posts: 2038
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:

Re: For Fun: Clojure-style Tail Recursion in newLISP

Post by cormullion »

I preferred:

Code: Select all

> (set '-.1 2)
2
:)

Locked