用C++实现了一个迷你的lisp解释器

用C++实现了一个迷你的lisp解释器用C++实现了一个迷你的lisp解释器找出需求和现存实现的相同部分-交；将这些部分加入程序中-并；然后慢慢打补丁吧。前两天和mayadong说到lisp，想起很久以前看过的一篇文章《Lisp之根源》()。当时看得似懂非懂，于是想找来再看看。搜到文章以后，从头到尾看了一遍，基本上算是看懂了。文章中的lisp只有lambda,label以及7个原始操作符。而这种lisp的有趣之处是它可以实现一个函数作为解释自己的解释器。不过这个解释器并不是解释字符形式的源码，而是解释表示lisp程序的表。看完文章后，我突然想，如果用C++实现一个这样的解释器如何呢？分析了一下，觉得应该不是很困难。在这几天找了些时间，做了这么一个东西。这个解释器相当简陋，甚至没有出错的处理，如果lisp程序有错，要么就没有任何反应，要么解释器本身就会挂掉。而且只能解释在《Lisp之根源》中说的那种lisp语言。所以冠之“迷你”以解嘲。其实用C++写解释器程序到没费太大的劲，只是用lisp测试时把我累坏了。lisp这语言真不是盖的，括号稀里哗啦一大堆，看得我眼花缭乱。为了输出结果，增加了一个print函数。用法：可以把lisp源程序作为参数传递给程序minilisp。如果没有参数，minilisp将试图执行test.lsp。比如，有一个subst.lsp文件：(defunsubst(xys);函数subst用x替换s中所有的y(cond((atoms)(cond((eqsy)x)('t

s)))('t

(cons(substxy(cars))(substxy(cdrs))))))(labels'(Hellothis(noanyHello)word))(print(subst'Hi'Hellos))F:\Projects\minilisp>minilispsubst.lsp(Hithis(noanyHi)word)源程序，可执行文件，及测试lisp程序，可以在这儿下载/p/scriptdraw/downloads/detail?name=minilisp.zip&can=2&q=#makechanges备用地址不想下载的，可以直接看下面的源程序：#include<iostream>#include<fstream>#include<string>#include<map>usingnamespacestd;#include<assert.h>typedefstring*Atom;//Cell为链表的节点，Cell*对应lisp中的表structCell{void*first;//节点的第一个元素，是一个原子(Atom)或一个链表(Cell*)Cell*rest;};//解析结果structResult{constchar*tail;//没有解析的源码位置void*parsed;

//解析出的内容Result(constchar*r,void*p):tail(r),parsed(p){}};typedefmap<Atom,void*>Environment;//包含各种变量的环境//------Atom------constintMAX_ATOMS=4096;//最大原子数string*atomTable;

//所有原子存放在一个统一的表中string*lastAtom;

//最后一个原子的位置map<string,Atom>atomDict;//原子字典，根据字符串查找对应的原子AtomatomTrue,atomLambda,atomQuote;//解释器中用到的原子boolisCell(void*p);

//指针p是否指向一个Cellvoidgc(Environment&env);

//进行垃圾收集void*gcAlloc(size_tsize);

//GC方式分配内存//创建一个原子AtomcreateAtom(conststring&sym){if(atomDict.find(sym)==atomDict.end()){//如果在字典中没有这个原子if(lastAtom<atomTable+MAX_ATOMS){//原子表中还有空位*lastAtom=sym;

//加入原子表中atomDict[sym]=lastAtom;

//放入原子字典++lastAtom;returnlastAtom-1;}else{return0;//原子溢出，简单起见，不处理}}returnatomDict[sym];//在原子表中已存在该原子，直接返回}//p是否是一个原子boolisAtom(void*p){returnatomTable<=p&&p<=atomTable+MAX_ATOMS;}//创建一个lisp中的表Cell*cons(void*fst,Cell*rst){Cell*c=(Cell*)gcAlloc(sizeof(Cell));c->first=fst;c->rest

=rst;returnc;}//------Parser------ResultparseList(constchar*p);ResultparseAtom(constchar*p);boolisAtomChar(charch);boolisBlank(charch);constchar*skipBlanks(constchar*p);//解析源码pResultparse(constchar*p){p=skipBlanks(p);//跳过空白if(*p=='('){

//如果是(，解析表returnparseList(p+1);}elseif(*p=='\''){//'表示quoteResultr=parse(p+1);returnResult(r.tail,cons(atomQuote,cons(r.parsed,0)));}elseif(isAtomChar(*p)){//如果是组成原子的字符returnparseAtom(p);}returnResult(p,0);}//解析原子ResultparseAtom(constchar*p){constchar*q=p;while(isAtomChar(*q)){++q;}returnResult(q,createAtom(string(p,q)));}//解析表ResultparseList(constchar*p){p=skipBlanks(p);if(*p==')'){//表结束了，返回一个空表()returnResult(p+1,0);}Resultrfirst=parse(p);//解析表中的第一个元素Resultrrest=parseList(rfirst.tail);//解析其它元素returnResult(rrest.tail,cons(rfirst.parsed,(Cell*)rrest.parsed));//将两者构造成一个表}//除'('')'和空白外都是原子字符boolisAtomChar(charch){returnch!='\0'&&ch!='('&&ch!=')'&&!isBlank(ch);}//空格、制表符、换行符等都是空白字符boolisBlank(charch){returnch==''||ch=='\t'||ch=='\v'||ch=='\r'||ch=='\n';}//跳过空白，返回值为p的非空白的开始位置constchar*skipBlanks(constchar*p){while(isBlank(*p))p++;returnp;}//------evaluate-------typedefvoid*(*PrimeFunc)(Environment*env,Cell*args);constintMAX_LAMBDAS=2048;void*evalExpression(Environment*env,Cell*expr);void*evalValue(Environment*env,void*v);//输出原子和表voidprint(void*x){if(x==0){cout<<"()";//空表}elseif(isAtom(x)){//原子Atomatom=(Atom)x;cout<<*atom;}else{//表cout<<"(";Cell*cell=(Cell*)x;while(cell){print(cell->first);cell=cell->rest;if(cell){cout<<"";}}cout<<")";}}//参数为表达式的函数//表达式直接传递给函数，不进行求值//quote,lambda,label,cond,defun对应的C++函数void*primeQuote(Environment*env,Cell*args){returnargs->first;}void*primeLambda(Environment*env,Cell*args){returncons(atomLambda,args);}void*primeLabel(Environment*env,Cell*args){if(isAtom(args->first)){AtomnameAtom=Atom(args->first);(*env)[nameAtom]=evalValue(env,args->rest->first);}return0;}void*primeCond(Environment*env,Cell*args){Cell*c=args;while(c!=0){if(isAtom(c->first))break;//error!Cell*pair=(Cell*)(c->first);if(evalValue(env,pair->first)!=0){returnevalValue(env,pair->rest->first);}c=c->rest;}return0;}void*primeDefun(Environment*env,Cell*args){Cell*lam

=cons(atomLambda,args->rest);void*name=args->first;returnprimeLabel(env,cons(name,cons(lam,0)));}//参数为值的函数//表达式求值后，将值传递给函数//print,car,cdr,cons...对应的函数void*primePrint(Environment*env,Cell*args){print(args->first);if(args->rest){cout<<"";primePrint(env,args->rest);}cout<<endl;return0;}void*primeFirst(Environment*env,Cell*args){if(args->first&&!isAtom(args->first)){Cell*arg1=(Cell*)(args->first);returnarg1->first;}return0;}void*primeRest(Environment*env,Cell*args){if(args->first&&!isAtom(args->first)){Cell*arg1=(Cell*)(args->first);returnarg1->rest;}return0;}void*primeCons(Environment*env,Cell*args){returncons(args->first,(Cell*)(args->rest->first));}void*primeAtom(Environment*env,Cell*args){if(args->first==0||isAtom(args->first)){//returnatomTrue;}return0;}void*primeEq(Environment*env,Cell*args){void*fst=args->first;void*snd=args->rest->first;if(fst==0&&snd==0||isAtom(fst)&&isAtom(snd)&&fst==snd){returnatomTrue;}return0;}void*primeList(Environment*env,Cell*args){returnargs;}//函数和名称对应的表，用于注册函数PrimeFuncexprArgFuncTable[]={primeQuote,primeLambda,primeLabel,primeCond,primeDefun};constchar*exprArgFuncNames[]={"quote","lambda","label","cond","defun"};PrimeFuncvalArgFuncTable[]={primePrint,primeFirst,primeRest,primeCons,primeAtom,primeEq,primeList};constchar*valArgFuncNames[]={"print","car","cdr","cons","atom","eq","list"};//注册函数到lisp#defineREGISTER_FUNCTIONS(env,type)registerFunctions(env,type##Names,type##Table,sizeof(type##Names)/sizeof(constchar*))voidregisterFunctions(Environment&env,constchar**names,PrimeFunc*funcs,size_tn){for(unsignedi=0;i<n;i++){AtomnameAtom=createAtom(names[i]);env[nameAtom]=funcs+i;}}boolisExprArgFunc(void*p){constchar*tab=(constchar*)exprArgFuncTable;returntab<=p&&p<tab+sizeof(exprArgFuncTable);}boolisValArgFunc(void*p){constchar*tab=(constchar*)valArgFuncTable;returntab<=p&&p<tab+sizeof(valArgFuncTable);}void*getValue(Environment*env,Atomname){Environment::iteratorit=env->find(name);if(it!=env->end())returnit->second;return0;}void*evalValue(Environment*env,void*v){if(isAtom(v)){returngetValue(env,Atom(v));}else{returnevalExpression(env,(Cell*)v);}}Cell*evalArguments(Environment*env,Cell*args){if(args==0)return0;returncons(evalValue(env,args->first),evalArguments(env,args->rest));}//对一个表达式(也是一个表)求值void*evalExpression(Environment*env,Cell*expr){if(expr==0)//空表return0;void*v

=evalValue(env,expr->first);//对表的第一个元素求值if(v!=0){if(isExprArgFunc(v)){//如果是传表达式的函数PrimeFuncfn=*(PrimeFunc*)v;//转换成函数指针returnfn(env,expr->rest);

//将表达式直接传递给函数}elseif(isValArgFunc(v)){

//如果是传值的函数PrimeFuncfn=*(PrimeFunc*)v;returnfn(env,evalArguments(env,expr->rest));//对参数的表达式求值，再传递给函数}else{if(isCell(v)){//如果是CellCell*c=(Cell*)v;Atomfst=Atom(c->first);if(Atom(c->first)==atomLambda){//如果是lambda表达式Cell*rest=c->rest;Cell*params=(Cell*)(rest->first);void*body=rest->rest->first;Environmente=*env;Cell*argus=evalArguments(env,expr->rest);//对参数求值while(params){//将参数的值绑定到形参上Atomname=Atom(params->first);e[name]=argus->first;params=params->rest;if(argus)argus

=argus->rest;}returnevalValue(&e,body);//对lambda表达式体求值}}}}return0;}voidevalStatement(Environment&env,Cell*stmt){evalExpression(&env,stmt);gc(env);}//------GC-------//简单的垃圾回收void*gcmem;char*gcptr;void*tomem;char*toptr;constintMAX_MEM=64*1024;boolisCell(void*p){returngcmem<=p&&p<gcptr;}voidgcInit(){gcptr=(char*)(gcmem=malloc(MAX_MEM));}voidgcEnd(){free(gcmem);}//4字节对齐inlinevoid*align(char*val){return(void*)(((unsigned)val+3)&~3);}//gcmem指向大块内存，每次分配直接从中划出来void*gcAlloc(size_tsize){assert(gcptr<(char*)gcmem+MAX_MEM);void*p=0;if(gcptr+size<(char*)gcmem+MAX_MEM){p=gcptr;gcptr=(char*)align(gcptr+size);}returnp;}//回收//遍历内存进行复制void*gcVisit(Cell*c){void*p=c->first;if(tomem<=p&&p<toptr){returnp;}Cell*toc=(Cell*)toptr;//将访问到Cell复制到新分配的内存中*toc=*c;c->first=toptr;toptr+=sizeof(Cell);if(isCell(toc->first)){//如果第一个元素是一个Celltoc->first=gcVisit((Cell*)(toc->first));//访问之}if(toc->rest){toc->rest=(Cell*)gcVisit(toc->rest);//访问其它的元素}returntoc;}//在执行完一个语句后，进行一次回收voidgc(Environment&env){toptr=(char*)(tomem=malloc(MAX_MEM));//先分配同样大的内存for(Environment::iteratorit=env.begin();it!=env.end();++it){//从环境中变量使用的Cell出发if(isCell(it->second)){it->second=gcVisit((Cell*)(it->second));//访问每个用到的Cell}}free(gcmem);gcmem=tomem;gcptr=toptr;}//判断括号是否匹配boolparenMatched(conststring&stmt){intcounter=0;for(unsignedi=0;i<stmt.length();i++){if(stmt[i]=='(')++counter;elseif(stmt[i]=='