For Fun: Clojure-style Tail Recursion in newLISP

Featuring the Dragonfly web framework

For Fun: Clojure-style Tail Recursion in newLISP

Postby rickyboy » Tue Apr 02, 2013 10:03 pm

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

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

Postby xytroxon » Thu Apr 04, 2013 1:10 am

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
xytroxon
 
Posts: 295
Joined: Tue Nov 06, 2007 3:59 pm

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

Postby cormullion » Thu Apr 04, 2013 9:07 am

but then
Code: Select all
> (set '.x '(1 2 3))
(1 2 3)
> .x
(1 2 3)
cormullion
 
Posts: 2037
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W

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

Postby rickyboy » Thu Apr 04, 2013 3:16 pm

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

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

Postby Lutz » Thu Apr 04, 2013 6:01 pm

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 ;)
Lutz
 
Posts: 5258
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California

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

Postby rickyboy » Thu Apr 04, 2013 6:31 pm

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

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

Postby xytroxon » Thu Apr 04, 2013 9:40 pm

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
xytroxon
 
Posts: 295
Joined: Tue Nov 06, 2007 3:59 pm

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

Postby Lutz » Thu Apr 04, 2013 11:55 pm

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
Lutz
 
Posts: 5258
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California

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

Postby rickyboy » Fri Apr 05, 2013 1:14 am

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

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

Postby cormullion » Fri Apr 05, 2013 10:38 am

I preferred:

Code: Select all
> (set '-.1 2)
2


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


Return to So, what can you actually DO with newLISP?

Who is online

Users browsing this forum: No registered users and 2 guests

cron