[WIP] LISP-like

lisp.cpp

#include <iostream>
#include <variant>
#include <any>
#include <string>
#include <type_traits>
#include <functional>
#include <limits>
#include <unordered_map>
#include <stack>

namespace {

template <class T, class... Args>
const T *try_get(const std::variant<Args...> &value) {
    return std::get_if<T>(&value);
}

template <class T, class... Args>
T *try_get(std::variant<Args...> &value) {
    return std::get_if<T>(&value);
}

template <class T>
const T *try_get(const std::any &value) {
    return std::any_cast<T>(&value);
}

template <class T>
T *try_get(std::any &value) {
    return std::any_cast<T>(&value);
}

} // namespace

namespace lisp {

struct nil {
    constexpr nil() {}
    
    template <class T>
    constexpr bool operator == (const T &) const { return false; }
    friend std::ostream &operator <<(std::ostream &os, const nil &) {
        os << "nil";  
        return os;
    }
};

class symbol {
public:
    using unique_id_type = unsigned int;
    static constexpr unique_id_type invalid_id = std::numeric_limits<unique_id_type>::max();

    static symbol make_symbol() { return symbol(current_unique_id++); }

    struct hash {
        size_t operator ()(const symbol &key) const {
            return std::hash<unique_id_type>()(key.id());
        }
    };

public:
    symbol() : symbol(invalid_id) {}
    symbol(const symbol &other) : symbol(other._unique_id) {}
    symbol(symbol &&other) : symbol(std::move(other._unique_id)) {}
    
    symbol &operator =(const symbol &other) {
        _unique_id = other._unique_id;
        return *this;
    }
    
    bool operator ==(const symbol &other) const {
        return _unique_id == other._unique_id;
    }
    
    bool operator !=(const symbol &other) const {
        return _unique_id != other._unique_id;
    }
    
    unique_id_type id() const { return _unique_id; }
    
    bool valid() const { return id() != invalid_id; }
    
private:
    unique_id_type _unique_id;

private:
    static unique_id_type current_unique_id;    
    
    symbol(unique_id_type id) : _unique_id(id) {}
};

symbol::unique_id_type symbol::current_unique_id = 0;

struct meta_s_exp : public std::any { using any::any; };
struct meta_env : public std::any { using any::any; };

using atom = std::variant<nil, bool, int, std::string, symbol>;
using pair = std::pair<meta_s_exp, meta_s_exp>;
using s_exp = std::variant<atom, pair>;

using function = std::function<s_exp (meta_env &, const s_exp &)>;

using scope = std::unordered_map<symbol, s_exp, symbol::hash>;

constexpr atom nil_atom(nil());

template <class T>
s_exp make_atom(const T &value) {
    return atom(value);
}

s_exp make_nil() {
    return make_atom(nil());
}

s_exp make_symbol() {
    return make_atom(symbol::make_symbol());
}

template <class T>
s_exp make_s_exp(const T &value) {//std::cout << "<" << typeid(value).name() << ">";
    return s_exp(value);
}

s_exp make_s_exp(const char * value) {//std::cout << "<" << typeid(value).name() << ">";
    return s_exp(std::string(value));
}

template <>
s_exp make_s_exp<meta_s_exp>(const meta_s_exp &any) {//std::cout << "<any>";
    if (auto *p = try_get<s_exp>(any)) {
        return make_s_exp(*p);
        
    } else if (auto *p = try_get<atom>(any)) {
        return make_s_exp(*p);
        
    } else if (auto *p = try_get<pair>(any)) {
        return make_s_exp(*p);
    }
    return make_nil();
}

template <class T0, class T1>
s_exp make_pair(const T0 &a, const T1 &b) {//std::cout << "<" << typeid(a).name() << ":" << typeid(b).name() << ">";
    return pair(make_s_exp(a), make_s_exp(b));
}

s_exp make_list() {
    return lisp::make_pair(nil(), nil());
}

template <class T>
s_exp make_list(const T &a) {
    return lisp::make_pair(a, nil());
}

template <class T, class... Args>
s_exp make_list(const T &a, Args&&... args) {
    return lisp::make_pair(a, make_list(std::forward<Args>(args)...));
}

template <class T>
const T *s_exp_cast(const s_exp &a) {
    if (auto *pa = try_get<atom>(a)) {
        if (auto *p = try_get<T>(*pa)) {
            return p;
        }
    }
    return nullptr;
}

template <class T>
T *s_exp_cast(s_exp &a) {
    if (auto *pa = try_get<atom>(a)) {
        if (auto *p = try_get<T>(*pa)) {
            return p;
        }
    }
    return nullptr;
}

s_exp car(const pair &a) {
    return make_s_exp(a.first);
}

s_exp car(const s_exp &a) {
    if (auto *p = try_get<pair>(a)) {
        return car(*p);
    }
    return make_nil();
}

s_exp cdr(const pair &a) {
    return make_s_exp(a.second);
}

s_exp cdr(const s_exp &a) {
    if (auto *p = try_get<pair>(a)) {
        return cdr(*p);
    }
    return make_nil();
}

bool operator ==(const s_exp &a, const s_exp &b) {
    if (auto *pa = try_get<atom>(a)) {
        if (auto *pb = try_get<atom>(b)) {
            return *pa == *pb;
        }
    } else if (auto *pa = try_get<pair>(a)) {
        if (auto *pb = try_get<pair>(b)) {
            return (car(*pa) == car(*pb)) && (cdr(*pa) == cdr(*pb));
        }
    }
    return false;
}

bool operator ==(const meta_s_exp &a, const meta_s_exp &b) {
    if (a.type() != b.type()) return false;
    if (!a.has_value() || !b.has_value()) return false;
    
    if (auto *pa = try_get<s_exp>(a)) {
        if (auto *pb = try_get<s_exp>(b)) {
            return *pa == *pb;
        }
    }
    return false;
}

template <class T>
bool operator ==(const meta_s_exp &a, const T &b) {
    if (!a.has_value()) return false;
    
    if (auto *pa = try_get<T>(a)) {
        return *pa == b;
    }
    return false;
}

bool operator ==(const pair &a, const pair &b) {
    return (a.first == b.first) && (a.second == b.second);
}

s_exp is_atom(const s_exp &a) {
    return atom(try_get<atom>(a) != nullptr);
}

s_exp equal(const s_exp &a) {
    return car(a) == cdr(a);
}

class environment {
public:
    using call_stack = std::stack<scope>;

public:
    environment() {}
    
    const scope &global_scope() const { return _global_scope; }
    scope &global_scope() { return _global_scope; }

    const scope &current_scope() const {
        return _call_stack.empty() ? global_scope() : _call_stack.top();
    }
    
    scope &current_scope() {
        return const_cast<scope &>(static_cast<const environment *>(this)->current_scope());
    }
    
    void push_call_stack() {
        _call_stack.push(scope());
    }
    
    void pop_call_stack() {
        _call_stack.pop();
    }
    
    void emplace(const symbol &key, const s_exp &value) {
        current_scope().emplace(key, value);
    }
    
    void emplace(const s_exp &key, const s_exp &value) {
        if (auto *p = lisp::s_exp_cast<lisp::symbol>(key)) {
            emplace(*p, value);
        }
    }
    
    void emplace_global(const symbol &key, const s_exp &value) {
        global_scope().emplace(key, value);
    }
    
    void emplace_global(const s_exp &key, const s_exp &value) {
        if (auto *p = lisp::s_exp_cast<lisp::symbol>(key)) {
            emplace_global(*p, value);
        }
    }
    
    bool empty() const {
        bool result = true;
        if (!_global_scope.empty()) {
            result = false;
            
        } else if (!_call_stack.empty()) {
            result = _call_stack.top().empty();
        }
        return result;
    }
    
    s_exp eval(const symbol &value) {
        if (!_call_stack.empty()) {
            auto &s = _call_stack.top();
            auto it = s.find(value);
            if (it != s.end()) {
                return it->second;
            }
        }
        if (!_global_scope.empty()) {
            auto it = _global_scope.find(value);
            if (it != _global_scope.end()) {
                return it->second;
            }
        }
        return make_nil();
    }
    
	s_exp eval(const meta_s_exp &a) {
	    if (!a.has_value()) return make_nil();
	    
	    if (auto *pa = try_get<s_exp>(a)) {
	        return eval(*pa);
	    }
	    return make_nil();
	}

	s_exp eval(const atom &a) {
        if (auto *pa = try_get<symbol>(a)) {
	        return eval(*pa);
	    }
	    return a;
	}

	s_exp eval(const pair &a) {
	    return make_pair(eval(a.first), eval(a.second));
	}

	s_exp eval(const s_exp &a) {
	    if (auto *pa = try_get<atom>(a)) {
	        return eval(*pa);

	    } else if (auto *pa = try_get<pair>(a)) {
	        return eval(*pa);
	    }
	    return make_nil();
	}

private:
    scope _global_scope;
    call_stack _call_stack;
};

std::ostream &operator <<(std::ostream &os, const meta_s_exp &value);
std::ostream &operator <<(std::ostream &os, const atom &value);
std::ostream &operator <<(std::ostream &os, const pair &value);
std::ostream &operator <<(std::ostream &os, const s_exp &value);

std::ostream &operator <<(std::ostream &os, const atom &value) {
    if (auto *p = try_get<lisp::nil>(value)) {
        os << *p;
        
    } else if (auto *p = try_get<bool>(value)) {
        os << *p;
        
    } else if (auto *p = try_get<int>(value)) {
        os << *p;
        
    } else if (auto *p = try_get<std::string>(value)) {
        os << '"' << *p << '"';
        
    } else if (auto *p = try_get<lisp::symbol>(value)) { (void)p;
        os << "symbol<" << p->id() << ">";
        
    } else {
        os << "atom";
    }
    return os;
}

std::ostream &operator <<(std::ostream &os, const meta_s_exp &value) {
    if (auto *p = try_get<lisp::s_exp>(value)) {
        os << *p;
        
    } else {
        os << "s_exp<" << value.type().name() << ">";
    }
    return os;
}

std::ostream &operator <<(std::ostream &os, const pair &value) {
    os << "( " << value.first << " . " << value.second << " )";
    return os;
}

std::ostream &operator <<(std::ostream &os, const s_exp &value) {
    if (auto *p = try_get<lisp::atom>(value)) {
        os << *p;
        
    } else if (auto *p = try_get<lisp::pair>(value)) {
        os << *p;
        
    } else {
        os << "s_exp";
    }
    return os;
}

} // namespace lisp

int main()
{
    std::cout << std::boolalpha;

    auto a = lisp::make_s_exp(100);
    
    std::cout << a << std::endl;

    auto b = lisp::make_pair(100, 200);
    
    std::cout << b << std::endl;

    auto foo = lisp::make_symbol();
    
    lisp::environment env;
    env.emplace(foo, lisp::make_s_exp(100));
    
    std::cout << foo << " := " << env.eval(foo) << std::endl;
    
    auto c = lisp::make_list(foo, 123, "foobar");
    
    std::cout << c << std::endl;
    
    auto d = lisp::make_pair(100, 200);
    
    std::cout << b <<  " == " << d << " ... " << (b == d) << std::endl;
    
    auto e = lisp::car(c);
    std::cout << "car " << c << " ... " << e << std::endl;
    
    auto f = lisp::cdr(c);
    std::cout << "cdr " << c << " ... " << f << std::endl;
    
    std::cout << "atom " << a << " ... " << is_atom(a) << std::endl;
    
    std::cout << "atom " << b << " ... " << is_atom(b) << std::endl;
}