Tiny Lisp, tiny interpreter

Python 2, 685 675 660 657 646 642 640 bytes

import sys,re
E=[]
G=zip("chtsle",[eval("lambda x,y=0:"+f)for f
in"[x]+y (x+[E])[0] x[1:] x-y +(x<y) +(x==y)".split()])
def V(e,L=E):
 while 1:
    try:return e and int("0%s"%e)
    except:A=e[1:]
    if""<e:return dict(G+L).get(e,e)
    f=V(e[0],L)
    if""<f:
     if f in"iv":t=V(A[0],L);e=(e[~bool(t)],t)[f>"u"];continue
     if"e">f:G[:]+=(A[0],V(A[1],L)),
     return A[0]
    if[]>f or f[0]:A=[V(a,L)for a in A]
    if[]>f:return f(*A)
    P,e=f[-2:];L=([(P,A)],zip(P,A))[P<""]
F=lambda x:V<x<""and"(%s)"%" ".join(map(F,x))or"%s"%x
for t in re.sub("([()])"," \\1 ",sys.stdin.read()).split():
 if")"==t:t=E.pop()
 if"("==t:E+=[],
 elif E:E[-1]+=t,
 else:print F(V(t))

Reads input from STDIN and writes output to STDOUT.

Although not strictly required, the interpreter supports nullary functions and macros, and optimizes tail calls executed through v.

Explanation

Parsing

To parse the input, we first surround each occurence of ( and ) with spaces, and split the resulting string into words; this gives us the list of tokens. We maintain an expression stack E, which is initially empty. We scan the tokens, in order:

• if we encounter a (, we push an empty list at the top of the expression stack;
• if we encounter a ), we pop the value at the top of the expression stack, and append it to the list that was previously below it on the stack;
• otherwise, we append the current token, as a string, to the list at the top of the expression stack (we keep integers as strings at this stage, and parse them during evaluation.)

If, when processsing an ordinary token, or after popping an expression from the stack due to ), the expression stack is empty, we're at a top-level expression, and we evaluate the value we'd otherwise have appended, using V(), and print its result, formatted appropriately using F().

Evaluation

We maintain the global scope, G, as a list of key/value pairs. Initially, it contains only the builtin functions (but not the macros, and not v, which we treat as a macro), which are implemented as lambdas.

Evaluation happens inside V(), which takes the expression to evaluate, e, and the local scope, L, which is, too, a list of key/value pairs (when evaluating a top-level expression, the local scope is empty.) The guts of V() live inside an infinite loop, which is how we perform tail-call optimization (TCO), as explained later.

We process e according to its type:

• if it's the empty list, or a string convertible to an int, we return it immediately (possibly after conversion to int); otherwise,

• if it's a string, we look it up in a dictionary constructed from the concatenation of the global and local scopes. If we find an associated value, we return it; otherwise, e must be the name of a builtin macro (i.e. q, i, d or v), and we return it unchanged. Otherwise, if e is not a string,

• e is a (nonempty) list, i.e., a function call. We evaluate the first element of the list, i.e., the function expression, by calling V() recursively (using the current local scope); we call the result f. The rest of the list, A, is the list of arguments. f can only be a string, in which case it's a builtin macro (or the function v), a lambda, in which case it's a builtin function, or a list, in which case it's a user-defined function or macro.

  If f is a a string, i.e., a builtin macro, we handle it in-place. If it's the macro i or v, we evaluate its first operand, and either select the second or third operand accordingly, in the case of i, or use the result of the first operand, in the case of v; instead of evaluating the selected expression recursively, which would defeat TCO, we simply replace e with the said expression, and jump to the beginning of the loop. If f is the macro d, we append a pair, whose first element is the first operand, and whose second element is the result of evaluating the second operand, to the global scope, G, and return the first operand. Otherwise, f is the macro q, in which case we simply return its operand directly.

  Othrtwise, if f is a lambda, or a list whose first element is not (), then it's a non-nullary function, not a macro, in which case we evaluate its arguments, i.e., the elements of A, and replace A with the result.

  If f is a lambda, we call it, passing it the unpacked arguments in A, and return the result.

  Otherwise, f is a list, i.e., a user-defined function or macro; its parameter list is the second-to-last element, and its body is the last element. Like in the case of the macros i and v, in order to perform TCO, we don't evaluate the body recursively, but rather replace e with the body and continue to the next iteration. Unlike i and v, however, we also replace the local scope, L, with the new local scope of the function. If the parameter list, P, is, in fact, a list, the new local scope is constructed by zipping the parameter list, P, with the argument list, A; otherwise, we're dealing with a variadic function, in which case the new local scope has only one element, the pair (P, A).

REPL

If you want to play with it, here's a REPL version of the interpreter. It supports redefining symbols, and importing files through either the command line arguments, or the (import <filename>) macro. To exit the interpreter, terminate the input (usually, Ctrl+D or Ctrl+Z).

try:import sys,re,readline
except:0
E=[];G=zip("chtsle",[eval("lambda x,y=0:"+f)for f
in"[x]+y (x+[E])[0] x[1:] x-y +(x<y) +(x==y)".split()])
def V(e,L=E):
 while 1:
    try:return e and int("0%s"%e)
    except:A=e[1:]
    if""<e:return dict(G+L).get(e,e)
    f=V(e[0],L)
    if""<f:
     if f in"iv":t=V(A[0],L);e=(e[~bool(t)],t)[f>"u"];continue
     if"e">f:G[:]+=(A[0],V(A[1],L)),
     elif"j">f:X(open(str(A[0])).read())
     return A[0]
    if[]>f or f[0]:A=[V(a,L)for a in A]
    if[]>f:return f(*A)
    P,e=f[-2:];L=([(P,A)],zip(P,A))[P<""]
F=lambda x:V<x<""and"(%s)"%" ".join(map(F,x))or"%s"%x
def X(s,v=0):
 for t in re.sub("([()])"," \\1 ",s).split():
    if")"==t:t=E.pop()
    if"("==t:E[:]+=[],
    elif E:E[-1]+=t,
    else:
     x=V(t)
     if v:print F(x)
for f in sys.argv[1:]:X("(g %s)"%f)
while 1:
 try:X(raw_input(">."[[]<E]*3+" "),1)
 except EOFError:break
 except KeyboardInterrupt:E=[];print
 except Exception as e:print"Error: "+e.message

And here's an example session, implementing merge sort:

>>> (d let d) (d if i) (d head h) (d tail t) (d prepend c) (d less l)
let
if
head
tail
prepend
less
>>>
>>> (let list (q (x... x...)))
list
>>> (let lambda (q (() (params body) (list params body))))
lambda
>>> (let def (q (() (name params body) (
...     v (list (q let) name (list (q lambda) params body))
... ))))
def
>>>
>>> (def else(body) body)
else
>>> (def or(x y) ( if x x y ))
or
>>> (def and(x y) ( if x y x ))
and
>>>
>>> (def front-half(L) ( front-half/impl L L ))
front-half
>>> (def front-half/impl(L M) (
...     if M (
...         prepend (head L)
...                 (front-half/impl (tail L) (tail (tail M)))
...     ) (else
...         ()
...     )
... ))
front-half/impl
>>>
>>> (def back-half(L) ( back-half/impl L L ))
back-half
>>> (def back-half/impl(L M) (
...     if M (
...         back-half/impl (tail L) (tail (tail M))
...     ) (else
...         L
...     )
... ))
back-half/impl
>>>
>>> (def merge(L M comp) (
...     if (and L M) (
...         if (comp (head M) (head L)) (
...             prepend (head M) (merge L (tail M) comp)
...         ) (else (
...             prepend (head L) (merge (tail L) M comp)
...         ))
...     ) (else (
...         or L M
...     ))
... ))
merge
>>>
>>> (def sort(L comp) (
...     if (and L (tail L)) (
...         merge (sort (front-half L) comp)
...               (sort (back-half L) comp)
...               comp
...     ) (else
...         L
...     )
... ))
sort
>>>
>>>
>>> (let my-list (list 4 7 2 5 9 1 6 10 8 3))
my-list
>>> my-list
(4 7 2 5 9 1 6 10 8 3)
>>> (sort my-list less)
(1 2 3 4 5 6 7 8 9 10)
>>> (sort my-list (lambda(x y) ( less y x )))
(10 9 8 7 6 5 4 3 2 1)

C (GNU), 1095 bytes

Much of the action takes place in the giant v function. Instead of implementing tail recursion explicitly, v is structured so that many of the calls from v to v will be handled by gcc's tail recursion optimization. There is no garbage collection.

This makes heavy use of GCC extensions, so it could only be compiled with gcc (use the command gcc -w -Os tl.c). It also uses some scanf extensions which were not available on Windows, which I usually use. The prospect of writing the parser with standard scanf was so awful that I used a Linux VM to test the program instead. Parsing without scanf character classes probably would have added 100+ bytes.

#define O(...)({o*_=malloc(32);*_=(o){__VA_ARGS__};_;})
#define P printf
#define F(I,B)({for(I;x->c;x=x->l)B;})
#define Z return
typedef struct o{struct o*n,*l,*c;int i,t;}o;E(o a,o b){Z
a.n?!strcmp(a.n,b.n):a.c?b.c&&E(*a.c,*b.c)&E(*a.l,*b.l):!b.c&a.i==b.i;}p(o*x){x->t?P("%d ",x->i):x->n?P("%s ",x->n):F(P("("),p(x->c);P(")"));}o*x,G,N;*C(o*h,o*t){Z
O(c:h,l:t);}o*v(o*x,o*e){o*W(o*l,o*e){Z
l->c?C(v(l->c,e),W(l->l,e)):&N;}o*y,*a,*f;int t;Z
x->c?y=v(x->c,e),x=x->l,t=y->i,t?9/t?a=v(x->c,e),t>7?(t>8?a->c:a->l)?:a:t>6?v(a,e):t<6?x=v(x->l->c,e),t>4?C(a,x):O(t:1,i:t>3?E(*a,*x):t>2?a->i<x->i:a->i-x->i):v((a-&N&&!a->t|a->i?x:x->l)->l->c,e):(t&1&&d(x->c->n,v(x->l->c,e)),x->c):(y->l->l->l?y=y->l:(x=W(x,e)),a=y->c,v(y->l->c,a->n?O(n:a->n,c:x,l:&G):F(f=&G,(f=O(n:a->c->n,c:x->c,l:f),a=a->l);f))):x->n?e->n?strcmp(x->n,e->n)?v(x,e->l):e->c:e:x;}d(o*n,o*x){*v(O(n:""),&G)=(o){n:n,c:x,l:O()};}*R(h){char*z,*q;Z
scanf(" %m[^ \n()]",&q)>0?h=strtoul(q,&z,10),C(*z?O(n:q):O(t:1,i:h),R()):~getchar()&1?q=R(),C(q,R()):&N;}main(i){for(;++i<12;)d(strndup("slecivthqd"+i-2,1),O(i:i));F(x=R(),p(v(x->c,&G)));}

Semi-ungolfed

typedef struct o o;
struct o {
    char* n;
    o* l, //next in this list
     * c; 
    int i,
        t;
} ;



#define O(...)({o*_=malloc(32);*_=(o){__VA_ARGS__};_;})

E(o a, o b) { //tests equality 
    return
        a.n ? !strcmp(a.n,b.n) :
        a.t ? a.i==b.i :
        a.c ? b.c && E(*a.c,*b.c)&E(*a.l,*b.l) :
        !b.c
    ;
}

#define P printf


p(o*x){
    x->t?P("%d ",x->i):x->n?P("%s ",x->n):({for(P("(");x->c;x=x->l)p(x->c);P(")");});
}


o*_,G,N; //N = nil



o*C(o*h,o*t){return O(c:h,l:t);}


/*
        2 3 4 5 6 7 8 9 10 11
        s l e c i v t h d  q
    */


o* v(o* x, o* e) { //takes list, int, or name
    o*W(o* l, o* e) { //eval each item in list
        return l->c ? C(v(l->c ,e), W(l->l, e)) : &N;
    }

    o*y,*a,*f;int t;
    return x->c ? //nonempty list = function/macro call
        y = v(x->c,e), //evals to function/macro
        x = x->l,   //list position of first arg (if it exists)
        (t=y->t)?   //builtin no., if any
             t>9 ?
              t&1 ? x->c // 11 = q
                : //10 = d
                (d(x->c,v(x->l->c,e)),x->c)
           : (a = v(x->c,e), //eval'd first arg
             t)>7 ? // t/h
                (t > 8 ? a->c : a->l) ?: a
           : t>6 ? //v
                v(a,e)
           : (x = x->l, //position of 2nd arg in list
             t)>5 ? //i
                v( (a->n||a->l||a->i|a->t>1 ? x : x->l)->c, e)
           : (x = v(x->c,e), //evaluated 2nd arg
             t)>4 ? // c
                C(a,x)
           : O(t:1,i:
                t>3 ? E(*a,*x) :  //e
                t>2 ? a->i<x->i : //l
                      a->i-x->i   //s
              )
        :
        (
            y->l->l->l ? //whether this is macro
                y = y->l :
                (x = W(x,e)),  //eval args
            a = y->c,  //a = arg list
            //a = a->n ? x=C(x, &N), C(a, &N) : a, //transform variadic style to normal
            v(y->l->c,
               a->n ? //variadic
                O(n:a->n,c:x,l:&G)
              : ({
                   for(f=&G; a->c; a=a->l,x=x->l)
                      f=O(n:a->c->n, c: x->c, l:f);
                   f;
                })
            )
        )
    :
    x->n ? // name
        e->n ?
            strcmp(x->n,e->n) ?
                v(x,e->l)
            : e->c
        : e
     : x; //int or nil
}

d(o*n,o*x){
    * v(O(n:""),&G) =
        (o){n:n->n,c:x,l:O()};
}


;
o*R(){
    char*z,*q;int h;
return scanf(" %m[^ \n()]",&q)>0?
    h=strtoul(q,&z,10),
    C(*z ? O(n:q) : O(t:1,i:h), R())
: getchar()&1?&N:(q=R(),C(q,R()));
}
main(i) {

    for(;++i<12;) d(O(n:strndup("slecivthdq"+i-2,1)),O(t:i));

    o *q;
    for(q=R(); q->c; q=q->l) p(v(q->c,&G));

}