Solve et Coagula

So I got asked a few times to post the source for the AS3 Lisp. I have and it’s here. Please keep in mind:

• I wrote this a year and a half ago and didn’t know AS3 or Lisp very well
• I never intended to release the source so I apologize if anyone is offended by any class names, variable names, function names or comments
• I have since figured out a way better way to handle symbols in the system and it would really clean up a ton of stuff
• Some one over at YCombinator News noticed that closures don’t seem to work and for that I apologize, if I were rewriting this (which I kinda am just in a different form) I would definitely make closures works since I now realize how important they are to Lisp

So back when Adobe released the Flash 9 Pre-Alpha I took the opportunity to learn AS3 by indulging in one of my favorite pastimes, writing a Lisp interpreter. And what’s even more odd than coding a Lisp interpreter for enjoyment is that when I had it to a point where it was somewhat working, I came up with an actual use for it. Anyway, going into the actual use I found for it is another story that has to do with the interesting bonus you get when you can run the same code on the server as you can on the client. So here’s the link and here’s the list of stuff that seems to work. Update: I posted the source for this, check out the entry here.

• mapcar
• apply,funcall
• every
• reduce
• find-if
• remove-if,remove-if-not
• prog1,prog2,progn
• push
• pop
• incf
• decf
• while
• until
• when
• unless
• with-output-to-string
• multiple-value-list
• multiple-value-call
• multiple-value-prog1
• multiple-value-bind
• nth-value
• dotimes
• dolist
• cons
• rplaca,rplacd
• list
• member
• reverse
• append
• list-length
• car,cdr
• last
• nth,nthcdr
• first,second……tenth
• caar….cddddr
• +,-,*,/
• expt
• mod
• rem
• random
• 1+,1-
• floor
• ceiling
• truncate
• round
• print
• princ
• format
• null
• zerop
• plusp,minusp
• oddp,evenp
• listp,atom
• symbolp
• numberp
• keywordp
• stringp
• quote
• backquote,unquote,unlist
• setq,set
• setf(car,cdr,symbol-value)
• defvar,defparameter
• if,cond
• and,or
• eval
• defun,defmacro
• lambda
• let,let*
• do,do*
• destructuring-bind
• macroexpand
• macroexpand-1
• intern
• symbol-name
• symbol-value
• symbol-function
• macro-function
• gensym
• values
• values-list
• =,/=,eq,equal
• <,<=
• >,>=
• not

So I’m working on a compiler that compiles Lisp-like code (half lisp half scheme) down to AS2 code. The first thing I had to do was convert the code into cps-style which required that I walk the code structure and manipulate the code. After trying a few different methods I wound up creating the BIND-CASE macro which combines the case/cond statement with a destructuring-bind. It winds up working like this:


(bind-case o
           ((=defun name args &rest body)
            ;the =defun makes sure that
            ;the value in that position is DEFUN
            (print "It's a defun statement"))
              
                          
           (((method &rest args) &rest rest)
            (print "It's some non-defun function call"))
  
           (otherwise
            ;the otherwise is nothing other than
            ;a bind to a single variable called OTHERWISE
            (print "it's something else")))


The macro takes the first argument and tries to bind it to the forms listed in the macro. It tries them in order and if one succeeds then it evaluates the body of that test, inside the body all of the variables from the form are available. Also any symbol that begins with an = requires that the value in that position is equal to the symbol name in that slot (without the = of course).

This macro wound up being quite useful and was way cleaner than the previous method of using DEFMETHOD and nested TYPECASE statements.

Anyway, without further adieu here’s the code. Let me know what you think or if you have any ideas to make it more useful, or if there was something that already did this that I totally overlooked.


(defun starts-with-= (a)
  (and (symbolp a)
       (eq (char (symbol-name a) 0) #\=)))
 
(defun remove-= (a)
  (intern (subseq (symbol-name a) 1)))
 
(defun convert-dbind (a)
  (let (match)
    (labels ((fn (v)
                 (typecase v
                       (cons
                        (cons (fn (car v)) (fn (cdr v))))
                       (otherwise
                        (if (starts-with-= v)
                            (let ((erv (remove-= v)))
                              (push `(eq ,erv ',erv) match)
                              erv)
                          v)))))
      (values (fn a) match))))
 
(defmacro bind-case (val &rest args)
  (let ((rtn (gensym)))
    `(catch ',rtn
       (or
        ,@(mapcar #'(lambda (a)
                      (destructuring-bind (db &rest body) a
                        (multiple-value-bind (b match)
                                               (convert-dbind db)
                          `(ignore-errors
                            (destructuring-bind ,b ,val
                              (and ,@match
                                   (throw ',rtn
                                        (progn ,@body))))))))
            args)))))


So I’m rewriting this post because I got off on a tangent before, so here’s the deal.

Clearly state the problem: I work in Actionscript a ton. I love recursion. Flash will only let you recurse 256 levels before crashing. We need a way to run code recursively as deep as we need to without crashing the player and without filling up the call stack. In short we need tail-call optimization.

Tail-call optimization is quite a simple concept.
Look at this code it’s just a really stupid way to add two numbers

function StupidAdder(a,b)
{
    if(b==0) return a;
    return StupidAdder(a+1,b-1);
}
trace(StupidAdder(10,20));

This works fine, unless the second number is over 256 (oh and don’t make the second number negative it won’t work either).
The big problem here is that even though we are calling return Adder(a+1,b-1); Flash still keeps the stack frame for the whole function around even though it’s no longer necessary. The only thing we need to remember is that when we get to the end that we need to return the final value to the trace statement. So anyway I wrote this code that adds two methods to each function you create.


_global.Function.__proto__.TailCall=function()
{
    arguments.unshift(this);
    throw(arguments);
}
_global.Function.__proto__.WithTailCall=function()
{
    arguments.unshift(this);
    var c=arguments;
    var rtn=null;
    while(c)
    {
        try
        {
            rtn=c.shift().apply(null,c);
            c=null;
        }
        catch(v)
        {
            c=v;
        }
    }
    return rtn;
}


This uses a try catch block to pop the stack and then call the next function needed. When a normal value is returned it just gets passed directly to the original requester. Now we can call our StupidAdder function like such.


function StupidAdder(a,b)
{
    if(b==0) return a;
    StupidAdder.TailCall(a+1,b-1);
}
trace(StupidAdder.WithTailCall(10,256));


And there you have it, completely unnecessary in this case, but a nice little gem to have in your back pocket for that one time you want to run a function that recurses 1000 times.

I’ve avoided it for long enough. I now have a blog and this is my first post. I figured that I’d make my first post a pointless and boring one, describing why I’ve decided to start blogging. But this is going to get lame really quick so here’s some bullet points.

• I’ve always got something that I’m either so excited about or so annoyed with that I will have ten different conversations about it with a bunch of different people at different times saying the same thing over and over.
• In these situations other people disagree with me and break my train of thought and get me side tracked.
• I always thought it’d be nice to have a URL to send people to and force them to read instead of trying to tell them why they’re wrong or why I’m right.
• No one outside of my circle of friends and co-workers get the opportunity to hear my brilliant opinions.

Anyway, that concludes my first post ever. It will probably be all down hill from here.