オレオレLisp処理系を実装してみた(1日目)

この週末でLisp処理系をスクラッチから作ってみたので、そのときのメモをアップしていきいます。
この記事はその初日のメモです。(2日目、3日目)

あんまり推敲もしてないので読みにくいかもしれません。
その日のコードは最後に Gist を貼っておきます。



== 1日目 ==
SICPを読んでて4章に入ったところで無性にLispをつくりたくなったので作ることにした。
Lispを実装したことないとLisperを名乗れないらしいとどこかで見た気がするので、
完成したら(REPLができたら)俺もLisperを名乗れるかもしれない。

実装言語はSICPだとSchemeだけど、C++にすることにした。理由は:
* 静的型付けでどうやって実装するのか考えてみたかった
* C++で書けばもしかして少しは速いんじゃないか、という下心

まず大雑把な設計を考える。

LISP-2にするとちょっと大変そうな気がするのでLISP-1にする。

Lispは変数じゃなくて値の方に型を持ってるらしいので、たぶんLispObjectみたいな
スーパークラスを作ってあげて、そいつを継承したサブクラスを作っていけばよさげ。

Cで書く場合はポインタのアラインメントを利用して下位バイトに型情報を持たせたり
するテクニックがあるらしいけど、GCまで自前実装しないといけなくなりそうなので却下。
GC は楽そうな std::shared_ptr を使う。

S式の内部表現はreadを書くのがだるいのでuSchemeRの本にあったみたいに
std::listとかにするかなーとも思ったけど、よく考えたらC++自体REPLがないから
std::listで楽できても違うS式を評価しようとするたびにコンパイルが
必要になる気がするので、 結局readは書かないとつらそう。

あとLispオブジェクトクラスとstd::listを継承したクラス作って大丈夫か自信ない。
というわけで、ちゃんとListになるクラスを真面目に作ることにする。

AtomはFixnumがあればいいか。

LispObject は virtual string str() = 0; を実装しといてprintはcoutに<<する
だけにしよう

とりあえずのクラス階層は
* LObj
** Fixnum
** List
** Env
** Proc
くらいか。

**

大まかな設計を決めたので適当に実装してく。

どうせオモチャなのでソース分割とかは考えずに #include <bits/stdc++.h>
と using namespace std; してヒャッハーすることにする。

LObjはvirtual static str() = 0;だけ書いといて、インスタンス化
できないようにしとく。あと typedef std::shared_ptr<LObj> lptr; しとく。

Fixnum はとりあえずint をメンバ変数にしといて value() で取り出せるように
しておく。

List を std::list をメンバに持ったクラスとして実装しようとしてたが、
そもそも Cons を作ってやればいいことに気づいた。

lptrでくるんだやつから特定のクラスのポインタを取り出すのに少し悩む。
typedef std::shared_ptr<Fixnum> FixnumP;
とか作っといで shared_ptr::dynamic_pointer_cast で変換する方向
で実装始めたけど、全部のクラスにxxxP用意しないと行けないのと、
どのみち各クラスのポインタを取り出したいときは生ポインタが必要なとき
なのでLObjにrawptr<T>()なメンバ関数を用意することにした。
取り出した生ポインタをまたlptrでくるむようなことをしなければOKだろう。

lptrなオブジェクトに対してprmcons, prmcar, prmcdr 等を実装して動くのを確認。

**

Proper Listを作るにはNILが必要なのでクラスに加える。
とりあえず List : public LObj な空のクラスをつくって
Nill : public List で継承、Cons は List を継承するように変更
した。これで listp, consp の関係と整合するはず。
NILはTHE_NILというグローバル変数でインスタンス化しておく。

そのうち環境フレームが必要になるので Env クラスを書く。
が、そのまえに Env のキーになる String, Symbolクラスが必要なので
そっちを先に作る。

Stringはstd::stringのラップ、Symbolも同様だけど、同じ文字列の
シンボルは同じメモリに配置できるようにしたいので、文字列からSymbol
が欲しくなったら必ずstd::unordered_map<std::string, lptr>なハッシュ経由で
取得するようにする。ハッシュは THE_SYMBOL_TABLE として1個だけ
生成しとく。

Envの実装に戻るEnvは原則として単なるハッシュなんだけど、階層構造になるので
外側のEnvを指すlptrなparentとハッシュ本体のstd::unordered_map<std::string, lptr>
として作った。あと一番外側のグローバル環境フレームとしてparentがTHE_NILの
EnvをひとつTHE_ENVIRONMENTとして生成しておく。
Env の親子を考慮して symbol -> lptr の変換する prmgetenv を実装。
prmdefine と prmsetenv がどういう意味論を持つべきか考えてそいつらも実装しておく。

Envから値を得るときに見つからなかったときに返すために Error クラスを 実装。

そろそろ内部構造が形をなしてきたのでちゃんとした PRINT 関数、printerlptr を書く。
Cons だったら printCons に飛んで、'('を出力したらまた
printerlptr を再帰的に呼び出すようにしてうまく行った。

eval を実装するために適当に Proc クラスと prmbegin とか prmcond などの
特殊形式の実装を始める。

疲れたので今日はここまで。（次の日のメモはこちら）

現在のクラス階層
class LObj
class Error : public LObj
class List : public LObj
class Nil : public List
class Cons : public List
class Fixnum : public LObj
class Symbol : LObj
class Env : public LObj
class Proc : public LObj

1日目のコード

	/*-
	* Copyright (c) 2014 Katsuyuki Tateishi <kt@wheel.jp>
	* All rights reserved.
	*
	* Redistribution and use in source and binary forms, with or without
	* modification, are permitted provided that the following conditions
	* are met:
	* 1. Redistributions of source code must retain the above copyright
	* notice, this list of conditions and the following disclaimer.
	* 2. Redistributions in binary form must reproduce the above copyright
	* notice, this list of conditions and the following disclaimer in the
	* documentation and/or other materials provided with the distribution.
	*
	* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
	* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
	* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
	* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
	* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
	* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
	* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
	* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
	* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
	* SUCH DAMAGE.
	*
	*/
	#define dbg(...) fprintf(stderr,__VA_ARGS__)
	#define dpr(x) cerr<<#x<<": "<<x<<endl;
	#define dprc(c) do{cerr<<#c<<":";for(auto&_i:(c)){cerr<<" "<<_i;}cerr<<endl;}while(0)
	#include <bits/stdc++.h>
	using namespace std;
	typedef pair<int, int> pii;
	typedef vector<int> vi;
	typedef vector<vi> vvi;
	int INF = 1e9+7;
	#define all(c) begin(c), end(c)
	#define tr(i,c) for(auto i=begin(c);i!=end(c);i++)
	#define rtr(i,c) for(auto i=(c).rbegin();i!=(c).rend();i++)
	#define rep(i,b) for(auto i=0;i<(b);i++)
	#define pb push_back
	#define sz(c) int((c).size())
	class LObj {
	public:
	virtual string str() const = 0;
	template <typename T> T *rawptr() {
	return dynamic_cast<T *>(this);
	}
	template <typename T> bool eqtype() {
	return typeid(T) == typeid(*this);
	}
	template <typename T> bool isa() {
	return dynamic_cast<T *>(this) != nullptr;
	}
	};
	typedef shared_ptr<LObj> lptr;
	lptr prmeval(const lptr& expr, const lptr& env);
	bool bprmeq(const lptr& l, const lptr& r) {
	return l.get() == r.get();
	}
	class Error : public LObj {
	private:
	string name;
	public:
	Error(const string& s) : name(s) {}
	virtual string str() const {
	return "#<Error: " + name + ">";
	}
	};
	lptr error(const string& s) {
	return lptr(new Error(s));
	}
	class List : public LObj {
	public:
	};
	bool bprmlistp(const lptr& p) { return p->isa<List>(); }
	class Nil : public List {
	public:
	Nil() {}
	virtual string str() const { return string("NIL"); }
	};
	const lptr NIL(new Nil());
	bool bprmnullp(const lptr& p) { return bprmeq(p, NIL); }
	class Cons : public List {
	private:
	lptr car;
	lptr cdr;
	public:
	Cons(const lptr& a, const lptr& d) : car(a), cdr(d) {}
	lptr getcar() const { return car; }
	lptr getcdr() const { return cdr; }
	void setcar(const lptr& val) { car = val; }
	void setcdr(const lptr& val) { cdr = val; }
	virtual string str() const {
	return string("(" + car->str() + " . " + cdr->str() + ")");
	}
	};
	lptr prmcons(const lptr& x, const lptr& y) {
	return lptr(new Cons(x, y));
	}
	lptr prmcar(const lptr& p) {
	return p->rawptr<Cons>()->getcar();
	}
	lptr prmcdr(const lptr& p) {
	return p->rawptr<Cons>()->getcdr();
	}
	lptr prmcadr(const lptr& p) {
	return prmcar(prmcdr(p));
	}
	lptr prmcons(const lptr& args) {
	return prmcons(prmcar(args), prmcadr(args));
	}
	lptr prmset_car(const lptr& c, const lptr& val) {
	c->rawptr<Cons>()->setcar(val);
	return c;
	}
	lptr prmset_car(const lptr& args) {
	return prmset_car(prmcar(args), prmcadr(args));
	}
	lptr prmset_cdr(const lptr& c, const lptr& val) {
	c->rawptr<Cons>()->setcdr(val);
	return c;
	}
	lptr prmset_cdr(const lptr& args) {
	return prmset_cdr(prmcar(args), prmcadr(args));
	}
	lptr prmnreverse(lptr& p) {
	lptr acc, lst, head, rest;
	acc = NIL;
	lst = p;
	while (!bprmnullp(lst)) {
	rest = prmcdr(lst);
	acc = prmset_cdr(lst, acc);
	lst = rest;
	}
	return acc;
	}
	bool bprmatom(const lptr& p) {
	return bprmnullp(p) || !bprmlistp(p);
	}
	class Fixnum : public LObj {
	private:
	int val;
	public:
	Fixnum(string s) {
	val = stoi(s);
	}
	Fixnum(int i) {
	val = i;
	}
	int value() {
	return val;
	}
	virtual string str() const {
	return to_string(val);
	}
	};
	class Symbol : LObj {
	private:
	string name;
	public:
	Symbol(string str) {
	name = str;
	}
	virtual string str() const {
	return name;
	}
	};
	class Env : public LObj {
	private:
	unordered_map<string, const lptr> hash;
	lptr parent;
	public:
	Env() : parent(NIL) {}
	Env(const lptr& p) : parent(p) {}
	lptr get(const string& s) {
	auto ret = hash.find(s);
	if (ret != end(hash)) {
	return ret->second;
	} else if (!bprmnullp(parent)) {
	return parent->rawptr<Env>()->get(s);
	} else {
	return error("Undefined symbol: " + s);
	}
	}
	lptr get(const lptr& sym) {
	return get(sym->rawptr<Symbol>()->str());
	}
	lptr set(const string& s, const lptr& val) {
	auto ret = hash.find(s);
	if (ret != end(hash)) {
	hash.emplace(s, val);
	return val;
	} else if (!bprmnullp(parent)) {
	return parent->rawptr<Env>()->set(s, val);
	} else {
	return error("Undefined symbol: " + s);
	}
	}
	lptr set(const lptr& sym, const lptr& val) {
	return set(sym->rawptr<Symbol>()->str(), val);
	}
	lptr define(const string& s, const lptr& val) {
	hash.emplace(s, val);
	return val;
	}
	lptr define(const lptr& sym, const lptr& val) {
	return define(sym->rawptr<Symbol>()->str(), val);
	}
	virtual string str() const {
	return string("#<Environment >");
	}
	};
	template <typename T>
	lptr prmgetenv(const lptr& env, const T& sym) {
	return env->rawptr<Env>()->get(sym);
	}
	template <typename T>
	lptr prmsetenv(const lptr& env, const T& sym, const lptr& val) {
	return env->rawptr<Env>()->set(sym, val);
	}
	template <typename T>
	lptr prmdefine(const lptr& env, const T& sym, const lptr& val) {
	return env->rawptr<Env>()->define(sym, val);
	}
	lptr THE_ENVIRONMENT(new Env());
	class Proc : public LObj {
	private:
	enum ProcType { PRIMITIVE, COMPOUND, };
	enum ProcType ptype;
	string name;
	function<lptr(const lptr&)> primproc;
	lptr comproc;
	lptr environ;
	public:
	Proc(string s, function<lptr(const lptr&)> f) :
	ptype(PRIMITIVE),
	name(s),
	primproc(f),
	comproc(NIL),
	environ(THE_ENVIRONMENT) {}
	Proc(const lptr& args, const lptr& env) :
	ptype(COMPOUND),
	name("Anonymous"),
	primproc(nullptr),
	comproc(args),
	environ(env) {}
	function<lptr(const lptr&)> getprimproc() {
	return primproc;
	}
	virtual string str() const {
	return string("#<Procedure " + name + ">");
	}
	};
	lptr prm_add_fixnum(const lptr& x, const lptr& y) {
	return lptr(new Fixnum(x->rawptr<Fixnum>()->value() + y->rawptr<Fixnum>()->value()));
	}
	/*
	* Special forms
	*/
	lptr prmbegin(const lptr& args, const lptr& env) {
	lptr clause, lst, ret;
	ret = NIL;
	for (lst = args; !bprmnullp(lst); lst = prmcdr(lst)) {
	ret = prmeval(prmcar(lst), env);
	}
	return ret;
	}
	lptr prmcond(const lptr& args, const lptr& env) {
	lptr clause, rest, cond;
	for (rest = args; !bprmnullp(rest); rest = prmcdr(rest)) {
	clause = prmcar(rest);
	cond = prmeval(prmcar(clause), env);
	if (bprmnullp(cond)) continue;
	return prmbegin(prmcdr(clause), env);
	}
	return NIL;
	}
	lptr prmquote(const lptr& args, const lptr& env) {
	return args;
	}
	lptr prmlambda(const lptr& args, const lptr& env) {
	return lptr(new Proc(args, env));
	}
	/*
	* Evaluator
	*/
	lptr prmeval(const lptr& expr, const lptr& env) {
	lptr op = prmcar(expr), operand = prmcdr(expr);
	if (bprmeq(op, prmgetenv(THE_ENVIRONMENT, "COND"))) {
	prmcond(operand, env);
	}
	return NIL;
	}
	/*
	* Printer
	*/
	ostream& printlptr(ostream& os, const lptr& p);
	ostream& printCons(ostream& os, const lptr& p) {
	lptr x = prmcar(p);
	lptr rest = prmcdr(p);
	printlptr(os, x);
	if (bprmnullp(rest)) {
	return os;
	} else if (rest->eqtype<Cons>()) {
	os << " ";
	return printCons(os, rest);
	} else {
	os << " . ";
	return printlptr(os, rest);
	}
	}
	ostream& printlptr(ostream& os, const lptr& p) {
	if (p->eqtype<Cons>()) {
	os << "(";
	printCons(os, p);
	os << ")";
	} else {
	os << p->str();
	}
	return os;
	}
	ostream& operator<<(ostream& os, const lptr& p) {
	return printlptr(os, p);
	}
	int main(int argc, char **argv) {
	lptr x = lptr(new Fixnum(10));
	lptr y = lptr(new Fixnum(1));
	lptr z = lptr(new Fixnum(3));
	lptr a = lptr(new Fixnum(5));
	lptr b = lptr(new Fixnum(7));
	lptr c = prmcons(x, prmcons(y, prmcons(z, prmcons(a, prmcons(b, NIL)))));
	dpr(NIL);
	dpr(x);
	cout << endl;
	dpr(y);
	cout << endl;
	dpr(c);
	c = prmnreverse(c);
	dpr(c);
	cout << endl;
	lptr d = prmcons(x, y);
	dpr(d);
	dpr(prmcar(d));
	dpr(prmcdr(d));
	lptr tmp = prmcar(d);
	prmset_car(d, prmcdr(d));
	prmset_cdr(d, tmp);
	dpr(d);
	cout << endl;
	dpr(prm_add_fixnum(x, y));
	cout << endl;
	prmdefine(THE_ENVIRONMENT, "LST", c);
	dpr(prmgetenv(THE_ENVIRONMENT, "LST"));
	return 0;
	}

view raw toylisp-day1.cc hosted with ❤ by GitHub