Lisp advent calender 2012 sample : 実例3

adv_sample_3_1.cc

#include <iostream>
#include <cassert>
#include <cstring>
#include <iterator>

class Cons;

enum class Tag { int_, cons, string };

class Lisp_ptr {
public:
  Lisp_ptr(int i) : tag_(Tag::int_), u_(i){}
  Lisp_ptr(Cons* c) : tag_(Tag::cons), u_(static_cast<void*>(c)){}
  Lisp_ptr(const char* s) : tag_(Tag::string), u_(static_cast<const void*>(s)){}

  Tag tag() const { return tag_; }

  template<typename T>
  T get() const;

private:
  Tag tag_;
  union U {
    U(void* p) : ptr_(p){}
    U(const void* p) : cptr_(p){}
    U(int i) : int_(i){}

    void* ptr_;
    const void* cptr_;
    int int_;
  } u_;
};

template<>
int Lisp_ptr::get<int>() const {
  assert(tag_ == Tag::int_);
  return u_.int_;
}

template<>
Cons* Lisp_ptr::get<Cons*>() const {
  assert(tag_ == Tag::cons);
  return static_cast<Cons*>(u_.ptr_);
}

template<>
const char* Lisp_ptr::get<const char*>() const{
  assert(tag_ == Tag::string);
  return static_cast<const char*>(u_.cptr_);
}


bool operator==(Lisp_ptr a, Lisp_ptr b){
  if(a.tag() != b.tag()) return false;

  switch(a.tag()){
  case Tag::int_: return (a.get<int>() == b.get<int>());
  case Tag::cons: return (a.get<Cons*>() == b.get<Cons*>());
  case Tag::string: return (strcmp(a.get<const char*>(), b.get<const char*>()) == 0);
  default: return false;
  }
}

bool operator!=(const Lisp_ptr& a, const Lisp_ptr& b){
  return !(a == b);
}



struct Cons {
  Lisp_ptr car;
  Lisp_ptr cdr;

  Cons(Lisp_ptr a, Lisp_ptr d) : car(a), cdr(d){};
};

constexpr auto NIL = static_cast<Cons*>(nullptr);


std::ostream& operator<<(std::ostream& o, Lisp_ptr p){
  switch(p.tag()){
  case Tag::int_:
    o << p.get<int>();
    break;

  case Tag::cons:
    o << '(';
    for(auto i = p; i.tag() == Tag::cons && i.get<Cons*>(); i = i.get<Cons*>()->cdr){
      o << i.get<Cons*>()->car << ' ';
    }
    o << "\b)";
    break;

  case Tag::string:
    o << p.get<const char*>();
    break;
  }
  return o;
}

///////////////////////////////////////////////////////////////

Lisp_ptr make_cons_list(std::initializer_list<Lisp_ptr> ilist){
  Lisp_ptr head = NIL;
  Lisp_ptr* next = &head;

  for(auto p : ilist){
    auto c = new Cons{p, NIL};
    *next = c;
    next = &(c->cdr);
  }

  return head;
}

////////////////////////////////////////////////////////////////

class ConsIter : public std::forward_iterator_tag{
public:
  ConsIter() : p_(NIL){}
  explicit ConsIter(Lisp_ptr p) : p_(p){}
  ConsIter(const ConsIter&) = default;

  ConsIter& operator=(const ConsIter&) = default;

  Lisp_ptr operator*() const
  { return p_.get<Cons*>()->car; }

  Lisp_ptr* operator->() const
  { return &(p_.get<Cons*>()->car); }

  ConsIter& operator++()
  { p_ = p_.get<Cons*>()->cdr; return *this; }

  ConsIter operator++(int){
    auto ret(*this);
    ++(*this);
    return ret;
  }

  bool operator==(const ConsIter& other) const
  { return this->p_ == other.p_; }

  bool operator!=(const ConsIter& other) const
  { return this->p_ != other.p_; }


  Lisp_ptr base()
  { return p_; }

private:
  Lisp_ptr p_;
};

ConsIter begin(Lisp_ptr p){
  return ConsIter(p);
}

ConsIter end(Lisp_ptr){
  return ConsIter(NIL);
}

////////////////////////////////////////////////////////////////

template<typename T>
inline
T destructor_cast(ConsIter i){
  return (*i).get<T>();
}

template<>
inline
Lisp_ptr destructor_cast(ConsIter i){
  return *i;
}

template<>
inline
ConsIter destructor_cast(ConsIter i){
  return i;
}

template<typename... F_Args>
struct destructor;

template<>
struct destructor<>{
  template<typename Iter, typename Fun, typename... Args>
  void operator()(Iter, Fun f, Args... args) const {
    f(args...);
  }
};

template<typename F_Arg1, typename... F_Args>
struct destructor<F_Arg1, F_Args...>{
  template<typename Iter, typename Fun, typename... Args>
  void operator()(Iter i, Fun f, Args... args) const{
    auto arg1 = destructor_cast<F_Arg1>(i);
    ++i;
    destructor<F_Args...>()(i, f, args..., arg1);
  }
};


template<typename Iter, typename Fun, typename Ret, typename... Args>
void entry_destructor(Iter b, Fun fun, Ret (Fun::*)(Args...)){
  destructor<Args...>()(b, fun);
}
  
template<typename Iter, typename Fun, typename Ret, typename... Args>
void entry_destructor(Iter b, Fun fun, Ret (Fun::*)(Args...) const){
  destructor<Args...>()(b, fun);
}
  
template<typename Iter, typename Fun, typename Ret, typename... Args>
void entry_destructor(Iter b, Fun fun, Ret (*)(Args...)){
  destructor<Args...>()(b, fun);
}

template<typename Fun>
void bind_cons_list(Lisp_ptr p, Fun fun){
  entry_destructor(begin(p), fun, &Fun::operator());
}



void parse_quote(Lisp_ptr p){
  bind_cons_list(p,
                 [](const char* sym , Lisp_ptr datum){
                   std::cout << "quote accepted: (" << sym << ' ' << datum << ")\n";
                 });
}

void parse_set_(Lisp_ptr p){
  bind_cons_list(p,
                 [](const char* sym , Lisp_ptr var, Lisp_ptr expr){
                   std::cout << "set! accepted: (" << sym << ' ' << var << " " << expr << ")\n";
                 });
}

void parse_lambda(Lisp_ptr p){
  bind_cons_list(p,
                 [](const char* sym , Lisp_ptr formals, ConsIter body){
                   std::cout << "lambda accepted: (" << sym << ' ' << formals << " " << body.base() << ")\n";
                 });
}

int main(){
  Lisp_ptr lis1 = make_cons_list({"quote", 1});
  Lisp_ptr lis2 = make_cons_list({"set!", "x", make_cons_list({"+", 1, 2})});
  Lisp_ptr lis3 = make_cons_list({"lambda",
        make_cons_list({"a", "b"}),
        make_cons_list({"+", "a", "b"})});

  parse_quote(lis1);
  parse_set_(lis2);
  parse_lambda(lis3);
}