lisp.cpp

// SmallLisp: a simple Lisp-like language shell implemented in C++.

#include <iostream>
#include <sstream>
#include <memory>
#include <map>
#include <list>
#include <cctype>
#include <exception>

using namespace std;

class Env;
class Datum;

class LispError : public exception {
public:
    LispError(string reason) : reason(reason) { };

    const char* what() const noexcept {
        return reason.c_str();
    }

    string reason;
};

// Wrapper for Lisp values. Ensures all Lisp values use shared_ptr
// for memory management.
class LispVal {
public:
    LispVal(Datum* datum = nullptr) : datum(datum) { };

    bool operator==(const LispVal& other) {
        return datum == other.datum;
    }

    shared_ptr<Datum> datum;

    void print(ostream& out);
    LispVal eval(Env& env);

    bool operator<(const LispVal& other) const {
        // Needed for use as a map key.
        return datum < other.datum;
    }
};

// Base class of all Lisp types.
class Datum {
public:
    virtual ~Datum() {
        // cerr << "gone datum\n";
    };
    virtual void print(ostream& out);
    virtual LispVal eval(LispVal& self, Env& env);
};

void LispVal::print(ostream& out) {
    datum->print(out);
}

LispVal LispVal::eval(Env& env) {
    return datum->eval(*this, env);
}

void Datum::print(ostream& out) {
    out << "(unknown object)";
}

LispVal Datum::eval(LispVal& self, Env& env) {
    // By default, all values evaluate to themselves.
    return self;
}

//// Integers.
class Int : public Datum {
public:
    Int(int value): value(value) { };
    virtual void print(ostream& out);

    const int value;
};

void Int::print(ostream& out) {
    out << value;
}

//// Symbols (Lisp identifiers).

// Symbols in Lisp are interned (all symbols with the same name are
// internally the same object). This makes comparison of symbols
// efficient. The only public interface for symbol creation is the
// Symbol::intern function.

class Symbol : public Datum {
public:
    static LispVal intern(string name);
    void print(ostream& out);
    LispVal eval(LispVal& self, Env& env);
    const string name;

    static LispVal nil();

private:
    Symbol(string name) : name(name) { };
    static map<string, LispVal> symbolTable;
};

// Map from symbol names to symbol objects.
map<string, LispVal> Symbol::symbolTable;

void Symbol::print(ostream& out) {
    out << name;
}

LispVal Symbol::intern(string name) {
    map<string, LispVal>::const_iterator it = symbolTable.find(name);
    LispVal sym;
    if (it == symbolTable.end()) {
        // cerr << "Interning " << name << endl;
        sym = LispVal(new Symbol(name));
        symbolTable[name] = sym;
    }
    else {
        sym = it->second;
    }
    return sym;
}

LispVal Symbol::nil() {
    LispVal nil = Symbol::intern("nil");
    return nil;
}

//// Cons cells (Lisp list building block).

// A list in Lisp is made of pairs, or cons cells, where the first
// element of the pair represents an element of the list, and the
// second element points to the rest of the list, i.e., another
// pair. The end of the list is indicated by the symbol `nil`.

class Cons : public Datum {
public:
    Cons(const LispVal& first, const LispVal& rest)
        : first(first), rest(rest) { };

    void print(ostream& out);
    LispVal eval(LispVal& self, Env& env);

    LispVal first;
    LispVal rest;
};


void printList(Cons* list, ostream& out) {
    static LispVal nil = Symbol::nil();

    out << "(";
    while (1) {
        list->first.print(out);
        if (list->rest == nil) {
            out << ")";
            break;
        }
        else {
            cout << " ";
            Datum *rest = &*list->rest.datum;
            list = dynamic_cast<Cons*>(rest);
            if (list) {
                continue;
            }
            else {
                cout << ". ";
                rest->print(out);
                cout << ")";
                break;
            }
        }
    }
}

void Cons::print(ostream& out) {
    printList(this, out);
}

//// Functions.

// Function objects have an `apply` method taking an argument list (a
// list of `LispVal`s), and returning a LispVal. This class can be
// inherited to implement specific kinds of functions.

class Fun : public Datum {
public:
    virtual LispVal apply(list<LispVal> args) {
        throw LispError("Called empty function\n");
    };
};

// Example addition function.
class AddFun : public Fun {
public:
    LispVal apply(list<LispVal> args) {
        int sum = 0;
        for (auto it = args.begin(); it != args.end(); ++it) {
            if (Int* val = dynamic_cast<Int*>(&*it->datum)) {
                sum += val->value;
            }
            else {
                stringstream error;
                error << "Expecting number, found something else: ";
                it->print(error);
                throw LispError(error.str());
            }
        }
        return LispVal(new Int(sum));
    }
};

// Evaluation of a list: A list of the form (f x1 ... xn) is evaluated
// by evaluating each element. If `f` evaluates to a function object
// (one inheriting from `Fun`), its `apply` method is called with the
// result of evaluating `x1 ... xn`.

LispVal Cons::eval(LispVal& self, Env& env) {
    LispVal callee = first.eval(env);
    list<LispVal> arglist;

    LispVal operands = rest;

    while (auto cons = dynamic_cast<Cons*>(&*rest.datum)) {
        LispVal arg = cons->first.eval(env);
        arglist.push_back(arg);
        rest = cons->rest;
    }

    if (auto fun = dynamic_cast<Fun*>(&*callee.datum)) {
        return fun->apply(arglist);
    }
    else {
        throw LispError("Not a function");
    }
}


//// Parsing.

LispVal readVal(istream& in) {
    static LispVal nil = Symbol::nil();

    char ch;
    in >> ch;

    if (!in.good()) { throw LispError("unexpected eof"); }

    if (ch == '(') {
        ch = (in >> ws).peek();
        if (!in.good()) { throw LispError("unexpected eof in list"); }
        if (ch == ')') {
            cin.get();
            return nil;
        }

        LispVal item = readVal(in);
        Cons* tail = new Cons(item, nil);
        LispVal result = LispVal(tail);

        while (1) {
            ch = (in >> ws).peek();
            if (!in.good()) { throw LispError("unexpected eof in rest"); }
            if (ch == ')') {
                ch = in.get();
                return result;
            }
            else {
                item = readVal(in);
                Cons* tailrest = new Cons(item, nil);
                tail->rest = LispVal(tailrest);
                tail = tailrest;
            }
        }


    }

    else {
        string text;
        bool isNumber = true;
        do {
            text += ch;
            if (ch < '0' || ch > '9') {
                isNumber = false;
            }
        } while (ch = in.get(), in.good() && ch != '(' && ch != ')' && !isspace(ch));
        in.unget();

        if (isNumber) {
            return LispVal(new Int(stoi(text)));
        }
        else {
            return Symbol::intern(text);
        }
    }
}

//// Environment (variable-value associations).

// An environment contains a map of variable-value bindings, and a
// pointer to a parent environment.

class Env {
public:
    map<LispVal, LispVal> bindings; // symbol -> value
    const shared_ptr<Env> parent;

    static shared_ptr<Env> make(const shared_ptr<Env>& parent);
    LispVal lookup(LispVal name);
    void add(const LispVal& name, const LispVal& value);

private:
    Env(const shared_ptr<Env>& parent) : parent(parent) { };
};

shared_ptr<Env> Env::make(const shared_ptr<Env>& parent) {
    return shared_ptr<Env>(new Env(parent));
}

// Variable lookup happens by searching up the environment chain until
// an environment has the desired variable, or none is found (in which
// case the variable is unbound).

LispVal Env::lookup(LispVal name) {
    Env* env = this;
    while (env) {
        auto it = env->bindings.find(name);
        if (it != bindings.end()) {
            return it->second;
        }
        else {
            env = &*env->parent;
        }
    }

    stringstream error;
    error << "Unbound variable ";
    name.print(error);
    throw LispError(error.str());
}

// Add a binding to the environment.
void Env::add(const LispVal& name, const LispVal& value) {
    bindings[name] = value;
}

// Symbol evaluation: a symbol `x` is evaluated by looking for a
// variable of the same name in the environment.
LispVal Symbol::eval(LispVal& self, Env& env) {
    return env.lookup(self);
}

//// Main program.

int main() {
    //// Create a standard environment.
    shared_ptr<Env> env = Env::make(nullptr);
    // Self-evaluating constants: nil (false / empty list) and t (true).
    env->add(Symbol::nil(), Symbol::nil());
    env->add(Symbol::intern("t"), Symbol::intern("t"));
    // Addition function.
    env->add(Symbol::intern("+"), LispVal(new AddFun()));

    // Read-Eval-Print loop.
    while (1) {
        try {
            cout << "lisp> ";
            LispVal val1 = readVal(cin);
            val1.eval(*env).print(cout);
            cout << endl;
        }
        catch (const LispError& err) {
            cerr << "Error: " << err.what() << endl;
        }
    }
    return 0;
}