为什么我的小lisp QUOTE不会?

我一直在编写基于minilisp编码的微型迷你lisp, McCarthy论文 (由Lisp的根源修订),并使用基于J Incunabulum的(可能令人反感的)风格。 并从这里使用PP_NARG宏。 我还受到了我以前的项目的激励,这是一个codegolf’ed lambda演算解释器 ,我后来发现它与1999年的ioccc Lisp解释器非常相似,特别是在使用游标而不是指针来指代内存地址时。

它似乎工作,包括读者代码。 但是,虽然eval(ATOM(QUOTE X))正确地产生T ,并且eval(ATOM(QUOTE(XYZ)))正确地产生NIL ,并且eval(QUOTE X)产生X ,并且eval(QUOTE(XYZ))产生(XYZ) ; 奇怪的结果是eval(QUOTE(ATOM(QUOTE X)))产生ATOM ,而不是完整的子表达式ATOM(QUOTE X)

我认为这是一个长镜头,我并没有让它变得简单,但任何人都可以帮助我找出引用出错的地方吗?

顺便说一下,与上面的描述不同,解释器仅限于单字符标记,因此QUOTEQATOMA ( github )

 /*cf. http://www.ioccc.org/1989/jar.2.c http://leon.bottou.org/projects/minilisp http://www.jsoftware.com/jwiki/Essays/Incunabulum http://www-formal.stanford.edu/jmc/recursive/recursive.html http://www.paulgraham.com/rootsoflisp.html https://codegolf.stackexchange.com/questions/284/write-an-interpreter-for-the-untyped-lambda-calculus/3290#3290 */ #include #include #include #include #include #include #include"ppnarg.h" #define R return int*m,*n,msz; tag(x){R x&3;} val(x){R x>>2;} #define ALPHA 'T' #define NIL (0) #define T atom(ALPHA) atom(x){R((x-ALPHA)<<2)|1;} number(x){R(x<<2)|3;} listp(x){R tag(x)==0;} atomp(x){R tag(x)==1;} objectp(x){R tag(x)==2;} numberp(x){R tag(x)==3;} consp(x){R x&&listp(x);} car(x){R consp(x)?val(x)[m]:0;} cdr(x){R consp(x)?val(x)[m+1]:0;} caar(x){R car(car(x));} cadr(x){R car(cdr(x));} cadar(x){R car(cdr(car(x)));} caddr(x){R car(cdr(cdr(x)));} caddar(x){R car(cdr(cdr(car(x))));} cons(x,y){int z;R z=nm,*n++=x,*n++=y,z<='0'&&**p>1)==-1); /*right-shift must be sign-preserving*/ n=m=sbrk(sizeof(int)*(msz=getpagesize()));*n++=0;*n++=0; //signal(SIGSEGV,fix); /*might let it run longer, obscures problems*/ char *s="(Q (A (QX)))"; char *p=s; int a=rd(&p); printf("%s\n",s); int x,y; x = a; y = NIL; prn(x); x = eval(x,y); printf("\nEVAL\n"); printf("x: %d\n", x); printf("0: %o\n", x); printf("0x: %x\n", x); printf("tag(x): %d\n",tag(x)); printf("val(x): %d\n",val(x)); printf("car(x): %d\n",car(x)); printf("cdr(x): %d\n",cdr(x)); prn(x); R 0; } 

这是由indent处理的相同代码。

 /*cf. http://www.ioccc.org/1989/jar.2.c http://leon.bottou.org/projects/minilisp http://www.jsoftware.com/jwiki/Essays/Incunabulum http://www-formal.stanford.edu/jmc/recursive/recursive.html http://www.paulgraham.com/rootsoflisp.html */ #include #include #include #include #include #include #include"ppnarg.h" #define R return int *m, *n, msz; tag (x) { R x & 3; } val (x) { R x >> 2; } #define ALPHA 'T' #define NIL (0) #define T atom(ALPHA) atom (x) { R ((x - ALPHA) << 2) | 1; } number (x) { R (x << 2) | 3; } listp (x) { R tag (x) == 0; } atomp (x) { R tag (x) == 1; } objectp (x) { R tag (x) == 2; } numberp (x) { R tag (x) == 3; } consp (x) { R x && listp (x); } car (x) { R consp (x) ? val (x)[m] : 0; } cdr (x) { R consp (x) ? val (x)[m + 1] : 0; } caar (x) { R car (car (x)); } cadr (x) { R car (cdr (x)); } cadar (x) { R car (cdr (car (x))); } caddr (x) { R car (cdr (cdr (x))); } caddar (x) { R car (cdr (cdr (car (x)))); } cons (x, y) { int z; R z = n - m, *n++ = x, *n++ = y, z <= '0' && **p > 1) == -1); /*right-shift must be sign-preserving */ n = m = sbrk (sizeof (int) * (msz = getpagesize ())); *n++ = 0; *n++ = 0; //signal(SIGSEGV,fix); /*might let it run longer, obscures problems*/ char *s = "(Q (A (QX)))"; char *p = s; int a = rd (&p); printf ("%s\n", s); int x, y; x = a; y = NIL; prn (x); x = eval (x, y); printf ("\nEVAL\n"); printf ("x: %d\n", x); printf ("0: %o\n", x); printf ("0x: %x\n", x); printf ("tag(x): %d\n", tag (x)); printf ("val(x): %d\n", val (x)); printf ("car(x): %d\n", car (x)); printf ("cdr(x): %d\n", cdr (x)); prn (x); R 0; } 

这是main的胆量,测试部分。

  char *s="(Q (A (QX)))"; char *p=s; int a=rd(&p); printf("%s\n",s); int x,y; x = a; y = NIL; prn(x); x = eval(x,y); printf("\nEVAL\n"); printf("x: %d\n", x); printf("0: %o\n", x); printf("0x: %x\n", x); printf("tag(x): %d\n",tag(x)); printf("val(x): %d\n",val(x)); printf("car(x): %d\n",car(x)); printf("cdr(x): %d\n",cdr(x)); prn(x); 

我得到的输出是:

 (Q (A (QX))) ( 'Q' ( 'A' ( 'Q' 'X' ) ) ) EVAL x: -75 0: 37777777665 0x: ffffffb5 tag(x): 1 val(x): -19 car(x): 0 cdr(x): 0 'A' 

你的读者错了,你的打印机对你撒谎。

提示:尝试阅读包含多个元素的列表,例如(1 2 3 4 5)

问题是rd调用append了它刚刚读取的元素作为第二个参数。 (修复已经存在,注释掉了。)在上面的测试用例中,恰好是一个列表本身,所以append工作。 但实际上你实际上传递给eval的数据

 (Q . (A . (Q . X))) 

正确打印时,或

 (QAQ . X) 

标准列表缩写。

所以是的, eval返回A ,这是正确的答案,除非您想检查没有意外的条款。

打印机中的错误是对于打印cdr的对,就像它是一个元素一样。 你应该在汽车和cdr之间打一个点,或者你应该编写一个辅助函数prnlst来执行缩写列表打印。

很迟到,但我终于让读者和打印机function(似乎)与上面的代码一起工作。

 prn(x){atomp(x)?printf("'%c' ",val(x)+ALPHA): numberp(x)?printf("%d ",val(x)): objectp(x)?printf("OBJ %d ",val(x)): consp(x)?printf("( "),prn(car(x)),printf(". "),prn(cdr(x)),printf(") "): printf("NIL ");} prnlst(x){ x==NIL?0: !consp(x)?prn(x): printf("( "),prnrem(x); } prnrem(x){ if(x==NIL)R;// printf(")0 "); if(car(x)!=NIL) prn(car(x)); else R;// printf(") "); null(cdr(x))? printf(") "): !listp(cdr(x))? prn(cdr(x)),printf(") "): printf(" "),prnlst(car(cdr(x))),prnrem(cdr(cdr(x))),printf(") "); } #define LPAR '(' #define RPAR ')' rd(char**p){int t,u,v,z; if(!(**p))R 0; if(**p==' ')R++(*p),rd(p); if(**p==RPAR)R++(*p),atom(RPAR); if(**p==LPAR){++(*p); z=NIL; u=rd(p); z=cons(u,NIL); while(u=rd(p),!eq(u,atom(RPAR))) u=cons(u,NIL), z=append(z,u); R z;} if(**p>='0'&&**p<='9')R++(*p),number(*((*p)-1)-'0'); R++(*p),atom(*((*p)-1));} 

现在它似乎正在工作,我已经在github上为它创建了一个项目页面。

它完全正确:

子表达式

 (QUOTE(ATOM(QUOTE X))) 

 (ATOM 'X) 

 (eval (atom 'x)) 

 'X 

(真正)