Angry Unix Programmer

I was curious (for like the 100th time in my life) about L-Systems and writing (for like the 10th time, apparently because I can't remember where I put code) a simple implementation of them. I wrote one that has hideous performance in like 10 minutes. Again.

I'd explain what an L-System is, but I don't think Wikipedia will mind if you ask it instead. The only somewhat interesting thing my code does is implement a reasonably generic algebraic inverse algorithm which allows generalized simplification of the generated L-System. You can read the docstrings for that info, there isn't much there. Also, when I say generalized, I mean that your rules and inverses better not need to detect more than one character to trigger a rewrite or annihilate an inverse.

Sigh. I remember when most of the web was actually useful stuff and it was interesting to read. Arcane knowledge was not only available, but generally explained in meaningful and insightful ways. The knowledge is still there, but most of the web these days is just people blogging derivative works from Wikipedia articles, or man pages, or each other, and acting as if the knowledge was discovered by themselves. Lame. I'm totally ignoring, nay, denying, the whole political and social aspects of the web too. I feel a lot better that way and you would too.

Hrm, maybe that is why I hadn't posted in quite some time. This post is just derivative junk too. In fact, I really just wrote it so I could make sure that the blogging software I wrote in 2005 didn't succomb to bitrot.

;; This code is written by Peter Keller (psilord@cs.wisc.edu) and has an MIT
;; License

(defun perform-rewrite (src rules)
  "Accept a string SRC which will be rewritten, in a left to right fashion, by
the supplied RULES. Return a string which is the rewrite. The RULES are in the
form of an assoc list: '((#\A . \"AB\") (#\B . \"A\")) and so on."
  (let ((rewrite ""))
    (dotimes (i (length src))
      (setf rewrite
            (concatenate
             'string rewrite
             (let ((rule (cdr (assoc (aref src i) rules
                                     :test #'char=))))
               (if rule
                   rule
                   (string (aref src i)))))))
    rewrite))


(defun remove-variables-from-l-system (src variables)
  "Accept a string SRC which contains constants and variables, and
another string VARIABLES, and remove all VARIABLES from the string,
returning a new string. All constants and variables are single
letters."
  (let ((rewrite ""))
    ;; First, we get rid of any variables, leaving only constants.
    (loop for i from 0 below (length src) do
         (setf rewrite
               (let ((current (aref src i)))
                 (concatenate
                  'string rewrite
                  (if (find current variables :test #'char=)
                      ""
                      (string current))))))
    rewrite))

(defun annihilate-inverses-from-l-system (src inverses)
  "Some L-Systems have inverses, like - being turn left 90 deg, and + being
turn right 90 deg. So, if you see a -+ in a row, then they cancel. So, take
a string of SRC and an assoc list of INVERSES in the form of
'((#\- . #\+) (#\+ . #\-)) and iterate the L-System until a fixed point is
reached where no more inverses wipe each other out. The return the simplified
string. The inverses are not very intelligent. For example, if - means
turn 90 deg to the left, and + means turn 180 degrees to the right. This system
is not smart enough to know that --+ means no operation. The inverses must be
exact duals of each other."
  ;; Then we handle inverse annihilation
  ;; iterate this until no more changes happen on the result.
  (let ((rewrite ""))
    (loop for i from 0 below (length src) do
         (setf rewrite
               (let ((current (aref src i)))
                 (concatenate
                  'string rewrite
                  (let ((inverse
                         (cdr
                          (find current inverses :test #'char= :key #'car))))
                    ;; If it is an inverse, we peek forward and see if
                    ;; the next character would wipe it out, if so, wipe
                    ;; both out and skip over them.
                    (if (not inverse)
                        ;; nothing to do, just copy it.
                        (string current)
                        ;; otherwise, let's check the future
                        ;; character, is it the inverse of the
                        ;; current character?
                        (if (and (< (1+ i) (length src))
                                 (char= (aref src (+ i 1)) inverse))
                            ;; We found that the inverse will be
                            ;; wiped out by the character next to
                            ;; it, increment i by an additional one
                            ;; to skip over it and return "" to
                            ;; represent that the current character
                            ;; got wiped out by its next character
                            (progn
                              (incf i 1)
                              "")
                            ;; The next character is either the end of
                            ;; the string or doesn't have an inverse
                            ;; that is equal to the current character,
                            ;; so just propagate the current one.
                            (string current))))))))
    rewrite))


(defun simplify-l-system (src variables inverses)
  "Simplify the SRC L-System be removing all VARIABLES and annihilating
INVERES. Return the simplified string."
  ;; First, clean out all of the variables, leaving only constants.
  (let ((rewrite (remove-variables-from-l-system src variables)))

    ;; Then iterate until all inverses have been annihilated.
    (let ((donep NIL))
      (loop :until donep :do
         (let ((next-rewrite
                (annihilate-inverses-from-l-system rewrite inverses)))
           (setf donep (string= rewrite next-rewrite)
                 rewrite next-rewrite))))

    ;; all done!
    rewrite))

;; and the final l-system, with simplification
(defun l-system (iterations axiom variables inverses rules
                 &key simplifyp)
  "Given the AXIOM string, a set of VARIABLES, INVERSES, and RULES, iterate
an ITERATIONS number of times to produce the L-System result and then either
simplifiy it or not according to the keyword argument :simplifyp"
  (let ((result axiom))
    (dotimes (i iterations)
      (setf result (perform-rewrite result rules)))
    (if simplifyp
        (simplify-l-system result variables inverses)
        result)))

;; Example: 5th order Hilbert Curve

;; Simplified:

;; (l-system 5 "A" "AB" '((#\- . #\+) (#\+ . #\-)) '((#\A . "-BF+AFA+FB-") (#\B . "+AF-BFB-FA+")) :simplifyp t)

;; "-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+F+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-F-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-F-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-F+F+F-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FFF+F+F-FF-F-F+F+F-F-FF-F+F+F-FF-F-F+FF+F+F-F-F+F+FF+F-F-FF-F+F+F-FF-F-F+F+F-F-FF-F+F+FF+F-F-F+FF+F+F-F-F+F+FF+F-F-FFF-F-F+FF+F+F-F-F+F+FF+F-F-F+FF+F+F-FF-F-F+F+F-F-FF-F+F+F-"

;; Unsimplified:

;; (l-system 5 "A" "AB" '((#\- . #\+) (#\+ . #\-)) '((#\A . "-BF+AFA+FB-") (#\B . "+AF-BFB-FA+")) :simplifyp nil)

;; "-+-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-+F+-+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+-F-+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+-+F+-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+-F-+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+F+-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-F-+AF-BFB-FA+F+-BF+AFA+FB-F-BF+AFA+FB-+F+AF-BFB-FA+-+F+-BF+AFA+FB-F-+AF-BFB-FA+F+AF-BFB-FA+-F-BF+AFA+FB-+-+-"

End of Line.

I had given a talk at the TC Lispers group in Minneapolis, MN on March 5th, 2012 about the reasoning behind and some of the internal design of CL-MW. For those interested, here are the slides of the presentation.

I've released CL-MW version 0.3 which implements the first of these improvements. Now you can say:

;; First, define a simple task algorithm
(define-mw-task-algorithm (foo)
  (+ foo 10))

;; later in the code:

...
(mw-with-task-policy-for-foo (add-foo :retry nil)
  ;; add a bunch of tasks, but don't retry them if they fail.
  (mapc #'add-foo '(1 2 3 4 5)))
...

;; and then you just get the results back asynchronously in the master's loop.

CL-MW is quicklisp installable so try it out and see what you think!

End of Line.

A friend of mine was asking about how to write a small interpreter so he can define new AI functions that his project can use at runtime. After his face blanked over when I started explaining how to do it in Common Lisp (really, there isn't that much explanation, it is like a fundamental property of Common Lisp to do such things), he hastily mentioned he wanted it in C.

Oh.

So, I hacked together a trivial demonstration program. This program runs a very small interpreter which allows one to compile a C file into a shared object, then load the shared object, and bind the functions inside of the shared object to a structure full of function pointers that you can then invoke manually. It is intended that one writes their varied functions as different C files that they can load and swap out at runtime.

Here is the lame makefile which compiles a program called stuff.c.

# Makefile

stuff: stuff.c
    gcc -Wall -g stuff.c -o stuff -ldl

clean:
    rm -f stuff *.o *.so

Here is stuff.c. This program is set up using a traditional interpreter design. However, it is totally barebones and I don't deal with the interpreter environment in any meaningful way (other than its reification and global nature) since you can't define new variables or functions in the interpreter. Also, the lexical and parsing analysis of the interpreted forms are horriffic at best. This is because doing such things in C is a pain in the ass unless you use flex and bison or are prepared to write a helluva lot more code. However, if I did that, this wouldn't be the simple demonstration that it is.

Note that I chose to perform the linking to the loaded library functions via an explicit indirection with the f structure in the Env structure. I could have just taken the func_name variable in eval_invoke() and simply performed a dlsym() call upon it and called the resulting pointer with the arguments. If I had done that, I could have called ANY function in the loaded library (well, with the same protoype at any rate). It is generally more general (in some respects) to do such a thing. However, I chose the method I did because through the indirection I can associate functions of different C linkage names to the symbols I use to identify them--such as the different names of the default functions in relation to the functions names as defined in the foo/bar.c codes.

A real world example of why the method I chose is useful would be if I wanted to have multiple implementations of C functions with the exact same name loaded at the same time where I could pick and choose between them. In the method I chose, I could additionally associate a namespace (or package name) with a shared object (meaning I'd pair the f and lib_name fields into a 'Package' structure and have a hash table of them in the Env keyed by package name that is specifed when loading the shared object) and use another syntax in the interpreter to state which function I want to call out of which namespace/package. This would be an exercise for the reader to implement.

/* This is stuff.c */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <dlfcn.h>

#define MATCH 0

#define TRUE 1
#define FALSE 0

#define DONE 0
#define NOT_DONE 1

#define BSIZE 1024

/* the type of the functions we care about in the compiled code */
typedef int (*FUNC)(int a, int b);

/* The extension of how to map function fromthe shared library to an API
    to them have very obvious extensions that what I did here. I didn't
    do any of them.
*/
typedef struct Funcs_t
{
    FUNC fun1;
    FUNC fun2;
    FUNC fun3;
} Funcs;

/* The global environmental structure */
typedef struct Env_t
{
    Funcs f;
    void *lib_handle;
} Env;

/* The invocable functions in the global environment are defaulted to these
    functions.
*/
int stub1(int a, int b)
{
    printf("Default stub1(%d, %d): called.\n", a, b);
    return a + b;
}

int stub2(int a, int b)
{
    printf("Default stub2(%d, %d): called.\n", a, b);
    return a + b;
}

int stub3(int a, int b)
{
    printf("Default stub3(%d, %d): called.\n", a, b);
    return a + b;
}

char *prompt_input(char *buf, int size, FILE *fin)
{
    printf("> ");
    fflush(NULL);
    return fgets(buf, size, fin);
}

int eval_help(char *args, Env *e)
{
    printf(
"Help:\n"
"  help               This help message\n"
"  quit               Quits the program\n"
"  compile <file>     Produces shared library of C file, don't provide the .c extension\n"
"  load <file>        Loads library named NAME by loading libNAME.so\n"
);

    return NOT_DONE;
}

int eval_quit(char *args, Env *e)
{
    printf("Quitting!\n");
    return DONE;
}

/* compile a source file (without the .c extension) and create a shared
    object we can load later. The error checking and reporting in this function
    is criminally bad.
*/
int eval_compile(char *args, Env *e)
{
    char cmd[BSIZE], file[BSIZE], buf[BSIZE];
    int ret;

    if (sscanf(args, "%s %s", cmd, file) != 2) {
        printf("eval_compile: bad arity!\n");
        return NOT_DONE;
    }

    /* construct and execute the compilaiton command. I hope everything
        is in your path.
    */

    sprintf(buf, "gcc -Wall -DPIC -fpic -c %s.c", file);
    ret = system(buf);
    if (ret != 0) {
        printf("Sorry, an error happened during compilation.\n");
        return NOT_DONE;
    } else {
        printf("Compile [%s.c]: OK\n", file);
    }

    /* Now produce the shared object */

    sprintf(buf, "gcc -shared -Wl,-soname,lib%s.so.1 %s.o -lc -o lib%s.so", 
        file, file, file);
    ret = system(buf);
    if (ret != 0) {
        printf("Sorry, an error happened during shared library generation.\n");
    } else {
        printf("Library generation [lib%s.so]: OK\n", file);
    }

    return NOT_DONE;
}

/* We only allow you to invoke the functions in the Env structure. You
    denote the names by "fun1" "fun2" and "fun3". This is a bare skeleton
    of how to do such things since I don't even create a symbol table for
    the mapping of the interpreter function symbol to actual C functions.
*/

int eval_invoke(char *cmd, Env *e)
{
    char buf[BSIZE], func_name[BSIZE];
    int arg0, arg1;
    int ret;

    if (sscanf(cmd, "%s %s %d %d", buf, func_name, &arg0, &arg1) != 4) {
        printf("eval_invoke: bad arity!\n");
        return NOT_DONE;
    }

    /* now execute the function we wanted to run with the arguments. */ 

    if (strncmp("fun1", func_name, 4) == MATCH) {
        printf("[Invoking function fun1...]\n");
        ret = (e->f.fun1)(arg0, arg1);
        printf("[Result] %d\n", ret);
    } else if (strncmp("fun2", func_name, 4) == MATCH) {
        printf("[Invoking function fun2...]\n");
        ret = (e->f.fun2)(arg0, arg1);
        printf("[Result] %d\n", ret);
    } else if (strncmp("fun3", func_name, 4) == MATCH) {
        printf("[Invoking function fun3...]\n");
        ret = (e->f.fun3)(arg0, arg1);
        printf("[Result] %d\n", ret);
    } else {
        printf("I'm sorry, there is no function to invoke by that name.\n");
    }

    return NOT_DONE;
}

int eval_load(char *cmd, Env *e)
{
    void *new_lib = NULL;
    char buf[BSIZE], lib_name[BSIZE];
    char name[BSIZE];

    if (sscanf(cmd, "%s %s", buf, lib_name) != 2) {
        printf("eval_load: bad arity!\n");
        return NOT_DONE;
    }

    sprintf(name, "./lib%s.so", lib_name);
    new_lib = dlopen(name, RTLD_NOW | RTLD_LOCAL);

    if (new_lib == NULL) {
        printf("Failed to load library: %s\n", name);
        return NOT_DONE;
    }

    /* close any previous one */
    if (e->lib_handle != NULL) {
        dlclose(e->lib_handle);
    }

    /* keep a reference to the new one */
    e->lib_handle = new_lib;

    /* "link" the functions in the Env to the ones we just loaded */
    e->f.fun1 = dlsym(e->lib_handle, "fun1");
    if (e->f.fun1 == NULL) {
        printf("Warning, unable to resolve fun1() from library %s, "
            "assuming initial stub1().\n", name);
        e->f.fun1 = stub1;
    }

    e->f.fun2 = dlsym(e->lib_handle, "fun2");
    if (e->f.fun2 == NULL) {
        printf("Warning, unable to resolve fun2() from library %s, "
            "assuming initial stub2().\n", name);
        e->f.fun2 = stub2;
    }

    e->f.fun3 = dlsym(e->lib_handle, "fun3");
    if (e->f.fun3 == NULL) {
        printf("Warning, unable to resolve fun3() from library %s, "
            "assuming initial stub3().\n", name);
        e->f.fun3 = stub3;
    }

    printf("Functions Linked!\n");

    return NOT_DONE;
}

/* The basic structure of the interpreter */
int eval_command(char *cmd, Env *e)
{
    printf("Evaluating command: '%s'\n", cmd);

    /* check to see what I have and run the appropriate handler */

    if (strncmp("help", cmd, 4) == MATCH) {
        return eval_help(cmd, e);
    }

    if (strncmp("quit", cmd, 4) == MATCH) {
        return eval_quit(cmd, e);
    }

    if (strncmp("compile", cmd, 7) == MATCH) {
        return eval_compile(cmd, e);
    }

    if (strncmp("invoke", cmd, 6) == MATCH) {
        return eval_invoke(cmd, e);
    }

    if (strncmp("load", cmd, 4) == MATCH) {
        return eval_load(cmd, e);
    }

    printf("Sorry, I don't know how to do that command.\n");
    return NOT_DONE;
}


int main(void)
{
    char buf[BSIZE];
    int done = NOT_DONE;
    char *ret = NULL;
    char *nl = NULL;
    Env e;

    /* set up defaults */
    e.f.fun1 = stub1;
    e.f.fun2 = stub2;
    e.f.fun3 = stub3;
    e.lib_handle = NULL;
    
    /* run the read/eval/print loop until done */

    printf("Welcome to a simple demonstration interpreter.\n");

    eval_help(NULL, &e);

    ret = prompt_input(buf, BSIZE, stdin);
    while(ret != NULL && done == NOT_DONE)
    {
        /* I'm not doing any real whitespace trimming, so be VERY careful */

        /* get rid of newline */
        nl = strstr(buf, "\n");
        if (nl != NULL) {
            *nl = '\0';
        }

        done = eval_command(buf, &e);
        if (done == NOT_DONE) {
            ret = prompt_input(buf, BSIZE, stdin);
        }
    }

    /* Clean up, if any */
    if (e.lib_handle != NULL) {
        dlclose(e.lib_handle);
        e.lib_handle = NULL;
    }
    
    return 0;
}

Now, here is the first file that we'll be using as a replacement for the stub functions. This file (and bar.c below) must be in the current working directory when you start the stuff program.

/* This is foo.c */

#include <stdio.h>
#include <stdlib.h>

int fun1(int a, int b)
{
    printf("This is foo.c:fun1()\n");
    fflush(NULL);

    return a + b;
}

int fun2(int a, int b)
{
    printf("This is foo.c:fun2()\n");
    fflush(NULL);

    return a + b;
}

int fun3(int a, int b)
{
    printf("This is foo.c:fun3()\n");
    fflush(NULL);

    return a + b;
}

And here is bar.c, another definition of the above functions.

/* This is bar.c */

#include <stdio.h>
#include <stdlib.h>

int fun1(int a, int b)
{
    printf("This is bar.c:fun1()\n");
    fflush(NULL);

    return a + b;
}

int fun2(int a, int b)
{
    printf("This is bar.c:fun2()\n");
    fflush(NULL);

    return a + b;
}

int fun3(int a, int b)
{
    printf("This is bar.c:fun3()\n");
    fflush(NULL);

    return a + b;
}

Now that we have everything defined, here is an interaction with the program. Notice the compilation of the above C files happens by us asking to compile them in the interpreter. Also notice how the output of the functions "fun1", "fun2", and "fun3" change away from the default to what is defined in each separate C file.

Linux black > ./stuff
Welcome to a simple demonstration interpreter.
Help:
  help               This help message
  quit               Quits the program
  compile <file>     Produces shared library of C file, don't provide .c
  load <file>        Loads library named NAME by loading libNAME.so\n"
> invoke fun1 10 10
Evaluating command: 'invoke fun1 10 10'
[Invoking function fun1...]
Default stub1(10, 10): called.
[Result] 20
> invoke fun2 10 10
Evaluating command: 'invoke fun2 10 10'
[Invoking function fun2...]
Default stub2(10, 10): called.
[Result] 20
> invoke fun3 10 10
Evaluating command: 'invoke fun3 10 10'
[Invoking function fun3...]
Default stub3(10, 10): called.
[Result] 20
> compile foo
Evaluating command: 'compile foo'
Compile [foo.c]: OK
Library generation [libfoo.so]: OK
> compile bar
Evaluating command: 'compile bar'
Compile [bar.c]: OK
Library generation [libbar.so]: OK
> load foo
Evaluating command: 'load foo'
Functions Linked!
> invoke fun1 10 10
Evaluating command: 'invoke fun1 10 10'
[Invoking function fun1...]
This is foo.c:fun1()
[Result] 20
> invoke fun2 10 10
Evaluating command: 'invoke fun2 10 10'
[Invoking function fun2...]
This is foo.c:fun2()
[Result] 20
> invoke fun3 10 10
Evaluating command: 'invoke fun3 10 10'
[Invoking function fun3...]
This is foo.c:fun3()
[Result] 20
> load bar
Evaluating command: 'load bar'
Functions Linked!
> invoke fun1 10 10
Evaluating command: 'invoke fun1 10 10'
[Invoking function fun1...]
This is bar.c:fun1()
[Result] 20
> invoke fun2 10 10
Evaluating command: 'invoke fun2 10 10'
[Invoking function fun2...]
This is bar.c:fun2()
[Result] 20
> invoke fun3 10 10
Evaluating command: 'invoke fun3 10 10'
[Invoking function fun3...]
This is bar.c:fun3()
[Result] 20
> quit
Evaluating command: 'quit'
Quitting!

Enhancement of the interpreter would go in the direction of allowing all of the functions in the shared object to be discovered and shoved into a symbol table stored in the Env environment so they can be called. In addition, the arguments of the functions would be more flexibly defined so you can pass other data types to them or define them to have different arities. There is definitely more that can be done.

End of Line.

CL-MW Version 0.2 is now available!

CL-MW is a Master/Slave library to help author pleasantly parallel Common Lisp applications. It is batch scheduler friendly and has examples and documentation in its complete manual for interfacing with the Condor batch scheduler. CL-MW is designed to be very easy to use and will readily generate executables that do not require an installed lisp environment for easy executable distribution across clusters.

The major feature enhancement for version 0.2 is that basic support for the lambda list keywords &optional, &key, and &rest have been made available for task algorithms. A new example in the sources demonstrates the use.

CL-MW is currently only supported on SBCL at this time. I will accept patches for other CL environments.

CL-MW is a part of Quicklisp and can be installed thusly:

* (ql:quickload "cl-mw")

You can find CL-MW and see an example hello world application here.

May this software serve your needs.

End of Line.

Once again I've made extensive changes to Option-9. I've released version 0.7, which implements hit points, damage points, mines, new powerups, almost completely reorganizes the code. Most importantly it adds a visually cool new weapon called the Tesla Field Weapon. The one trick with that weapon is you need to collect 5 of the asterisk style powerups to see it in the full glory.

Take a look at the screen shot.

I've also once again updated the theory of operations document. At this point, I'm likely not going to hack on the game anymore, since I think I've extracted what I wanted to learn out of it. Also, the document is starting to get a little unwieldy, so I'm unlikely to update it for future revisions of the game, if any.

Check it out.

End of Line.

After the public release of my Option 9 Theory of Operation document, people that actually know lisp read it and suggested a pile of changes to better my code and CLOS style. Most of those changes were in how I named my accessor functions and other generic functions. I definitely appreciate their comments.

I've made the changes, which were pretty extensive, released version 0.2, which has only a better repl as a new feature, and updated the theory of operations document to describe the new code and new object protocol. The changes definitely simplified my code and I'm closer to how CLOS wants me to think about OO problems.

Check it out.

End of Line.

In my quest to become fluent in Lisp, I wrote a small space shoot'em up video game called " Option 9 ". There were two versions of the game. The first one only took about 10 hours to write start to finish and that included learning how to use lispbuilder-sdl and cl-opengl. However, it was such a complete piece of unmaintainable trash that it will die a bitter death in the bit bucket. The second version took about the same amount of time to write and had many more features. It is this one that I will describe.

In the second version, I wanted to learn the Common Lisp Object System, or CLOS for short. My main source of learning CLOS is a book by Sonja E. Keene called "Object Oriented Programming in Common Lisp: A Programmer's Guide to CLOS". This book has VERY minor differences from the ANSI CLOS standard, which I may detail in a future blog post, and was written in 1989. However, it is still extremely useful and I found it to be a good and relevant read. It has excellent and clear explanations and does a great job of presenting the material.

I will say that CLOS is pretty awesome. Whenever I finish writing OOP code in Java or C++, I feel like I have to take a shower and speak in hushed tones about something in a garbage bag smelling of cheap perfume and meth that just got dumped into a ravine at 3am outside of Billings, Montana.

The thing I found with CLOS was that it just worked and I didn't have to write a lot of extraneous garbage to use it very effectively. In C++, there are so many mines in the minefield whose locations you have to remember that you don't have time or energy to dance in the grass. Even with my beginning understanding and use of CLOS, I easily saw that one just wrote less code while using it to represent an OO idea.

The biggest surprise was just how plainly useful multi-methods were. Multi-methods are generic methods which can specialize on more than one parameter. This is usually implemented with the Visitor Pattern in other languages which only support single dispatch. Having multiple dispatch readily in the language (and integrated with the rest of Lisp) prevented a lot of other code from being written that would obfuscate the intent. I appreciated this enormously. I find that I truly enjoy looking at code whose signal to noise ratio is very high.

Here is a screen shot of Option 9 in all of its vector art glory:

I wrote up a Theory of Operations document which is also a postmortem so you can both understand the code and my thought process in writing it. I provide the source so you can see it work for yourself. I don't just include my write up in this blog post itself since it is like 30 pages with images and that's a bit much to shove down the throat of RSS readers.

Check it out.

End of Line.

After a serious amount of time learning Lisp and hacking on my various projects, one of my projects has been released.

Check out CL-MW!

It is a distributed master/slave library written in pure Common Lisp designed to be easily integrated into batch processing systems like Condor. It currently works on SBCL and uses IOLib for its networking. I welcome patches to make it better and have a roadmap of features that need implementation.

I've written it to handle around 10,000 concurrent slaves and billions of fine to medium grain tasks. It has been tested in the low thousands of slaves and low billions of tasks with Condor and it ran very smoothly with moderate slave churn. Of course, once it gets into the wild I'm sure more bugs will be found and features desired.

Included are some example programs which illustrate the use of the library and a manual explaining how it all works. I would like to specifically thank Alan De Smet for his application of his excellent editing skills to the manual.

I'll soon make the rounds on comp.lang.lisp and cliki.net and whatnot announcing the library. It would be nice if it ended up in quicklisp too, so I have to figure that out as well. Hopefully other people besides me find CL-MW useful.

End of Line.

Intelligence is like a vaccine. If a lot of people get vaccinated the stupid is kept at bay. But I fear too many people are relying on herd immunity of late. When the first big stupid plague hits it'll be lights out for humanity.

End of Line.

I absolutely hate waiting for computers. One of the places I found myself waiting was emacs trying as hard as it can to suck Firefox or Konqueror up into my memory when ever I want to look up a Common Lisp symbol in SLIME in the Hyperspec. I could keep a browser window open to to the Hyperspec, but cycling to the window out of the many I have, or unminimizing it with the mouse and groveling around in it also became damn annoying after a while.

So I wrote this tiny piece of code. It uses the hyperspec package and fires up w3m in an xterm with the documentation in question. The interface to this code is the macro clhs. It is a macro because it'll autoquote the symbol given to it so you don't have to do it yourself. I love it a lot because I type a lisp command, the window pops up, I can navigate, and then make the window go away all without leaving the keyboard because the window pops up with keyboard focus. I've bracketed the code with #+sbcl because this is very specific to that implementation. It also needs the hyperspec-lookup library, but that is easy to get and configure.

I love it when the license is longer than the code.

;; Copyright (c) 2010 Peter Keller (psilord@cs.wisc.edu)
;; 
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;; 
;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;; THE SOFTWARE.

#+sbcl (require :hyperspec-lookup)

#+sbcl (defun clhs-impl (sym)
         (let* ((sym-name (symbol-name sym))
                (url (hyperspec:lookup sym-name)))
           (sb-ext:process-close
            (sb-ext:run-program
             "/bin/sh"
             (list "-c"
                   (concatenate 'string "COLUMNS=80 /usr/bin/xterm "
                                "-geom 80x70 -e /usr/bin/w3m " url " &"))
             :output t))))

#+sbcl (defmacro clhs (sym)
         `(clhs-impl ',sym))

You'd use it like this:

* (clhs read)

[control returns to repl and an xterm window pops up at the right web page]

I'm sure it won't be too hard to rebind SLIME's clhs lookup function to something like the above. Maybe when it isn't 2:30am, I'll make it work.

End of Line.