为什么我那小小的口齿不清的QUOTE? [英] Why won't my little lisp QUOTE?

问题描述

我一直基于 minilisp ，麦卡锡论文(由 Lisp的根源)，并根据此处中的PP_NARG宏.我以前的项目(我后来发现它与 1999年ioccc Lisp解释器，特别是在使用游标而不是 pointers 来指代内存地址的情况下.

I've been writing up a micro-mini-lisp based on the encoding in minilisp, the McCarthy paper (as emended by the Roots of Lisp), and using a (possibly objectionable) style based on the J Incunabulum. And using the PP_NARG macro from here. I was also motivated by my previous project, a codegolf'ed lambda calculus interpreter which I later discovered to be eerily similar to the 1999 ioccc Lisp interpreter, particularly in the use of cursors rather than pointers to refer to memory addresses.

似乎大多数情况下都有效，包括阅读器代码.但是，尽管eval(ATOM(QUOTE X))正确地产生了T，并且eval(ATOM(QUOTE(X Y Z)))正确地产生了NIL，并且eval(QUOTE X)产生了X，而eval(QUOTE(X Y Z))产生了(X Y Z)；奇怪的结果是eval(QUOTE(ATOM(QUOTE X)))会产生ATOM，而不是完整的子表达式ATOM(QUOTE X).

It mostly seems to work, including the reader code. But, although eval(ATOM(QUOTE X)) is correctly yielding T, and eval(ATOM(QUOTE(X Y Z))) is correctly yielding NIL, and eval(QUOTE X) yields X, and eval(QUOTE(X Y Z)) yields (X Y Z); the weird result is eval(QUOTE(ATOM(QUOTE X))) yields ATOM, not the full sub-expression ATOM(QUOTE X).

我想这是一个长镜头，但我并没有完全做到这一点，但是有人可以帮我弄清楚报价的错在哪里吗?

I suppose it's a long-shot, and I didn't exactly make it easy, but can anyone help me figure out where it's going wrong with the quoting?

顺便说一句，与上面的描述不同，解释器仅限于单字符标记，因此QUOTE是Q和ATOM是A. ( github )

By the way, unlike my description above, the interpreter is limited to single-character tokens, so QUOTE is Q and ATOM is A. (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<assert.h>
#include<signal.h>
#include<stdarg.h>
#include<stdio.h>
#include<stdlib.h>
#include<unistd.h>
#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<<2;}
rplaca(x,y){R consp(x)?val(x)[m]=y:0;}
rplacd(x,y){R consp(x)?val(x)[m+1]=y:0;}
eq(x,y){R atomp(x)&&atomp(y)?x==y:0;}
ff(x){R atomp(x)?x:ff(car(x));}
subst(x,y,z){R atomp(z)?(eq(z,y)?x:z):
        cons(subst(x,y,car(z)),subst(x,y,cdr(z)));}
equal(x,y){R(atomp(x)&&atomp(y)&&eq(x,y))
    ||(consp(x)&&consp(y)&&equal(car(x),car(y))&&equal(cdr(x),cdr(y)));}
null(x){R listp(x)&&(val(x)==0);}
lista(int c,int*a){int z=NIL;for(;c;)z=cons(a[--c],z);R z;}
listn(int c,...){va_list a;int*z=n;
    va_start(a,c);for(;c--;)*n++=va_arg(a,int);va_end(a);
    c=n-z;R lista(c,z);}
#define list(...) listn(PP_NARG(__VA_ARGS__),__VA_ARGS__)
append(x,y){R null(x)?y:cons(car(x),append(cdr(x),y));}
among(x,y){R !null(y)&&equal(x,car(y))||among(x,cdr(y));}
pair(x,y){R null(x)&&null(y)?NIL:
    consp(x)&&consp(y)?cons(list(car(x),car(y)),pair(cdr(x),cdr(y))):0;}
assoc(x,y){R eq(caar(y),x)?cadar(y):assoc(x,cdr(y));}
sub2(x,z){R null(x)?z:eq(caar(x),z)?cadar(x):sub2(cdr(x),z);}
sublis(x,y){R atom(y)?sub2(x,y):cons(sublis(x,car(y)),sublis(x,cdr(y)));}
apply(f,args){R eval(cons(f,appq(args)),NIL);}
appq(m){R null(m)?NIL:cons(list(atom('Q'),car(m)),appq(cdr(m)));}
eval(e,a){R numberp(e)?e:
    atomp(e)?assoc(e,a):
    atomp(car(e))?(
    /*QUOTE*/      eq(car(e),atom('Q'))?cadr(e):
    /*ATOM*/       eq(car(e),atom('A'))?atomp(eval(cadr(e),a)):
    /*EQ*/         eq(car(e),atom('E'))?eval(cadr(e),a)==eval(caddr(e),a):
    /*COND*/       eq(car(e),atom('D'))?evcon(cdr(e),a):
    /*CAR*/        eq(car(e),atom('H'))?car(eval(cadr(e),a)):
    /*CDR*/        eq(car(e),atom('R'))?cdr(eval(cadr(e),a)):
    /*CONS*/       eq(car(e),atom('C'))?cons(eval(cadr(e),a),eval(caddr(e),a)):
        //eval(cons(assoc(car(e),a),evlis(cdr(e),a)),a) ):/*cf. Roots of Lisp*/
        eval(cons(assoc(car(e),a),cdr(e)),a) ):
    eq(caar(e),atom('M'))?          /*LABEL*/
        eval(cons(caddar(e),cdr(e)),cons(list(cadar(e),car(e)),a)):
    eq(caar(e),atom('L'))?          /*LAMBDA*/
        eval(caddar(e),append(pair(cadar(e),evlis(cdr(e),a)),a)):0;}
evcon(c,a){R eval(caar(c),a)?eval(cadar(c),a):evcon(cdr(c),a);}
evlis(m,a){R null(m)?NIL:cons(eval(car(m),a),evlis(cdr(m),a));}
maplist(x,f){R null(x)?NIL:cons(apply(f,x),maplist(cdr(x),f));}

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)),prn(cdr(x)),printf(") "):
    0//printf("NIL ")
    ;}

#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,z);
        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));}

void fix(x){signal(SIGSEGV,fix);sbrk(msz);msz*=2;}
int main(){
    assert((-1>>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 (Q X)))";
    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<assert.h>
#include<signal.h>
#include<stdarg.h>
#include<stdio.h>
#include<stdlib.h>
#include<unistd.h>
#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 << 2;
}

rplaca (x, y)
{
  R consp (x) ? val (x)[m] = y : 0;
}

rplacd (x, y)
{
  R consp (x) ? val (x)[m + 1] = y : 0;
}

eq (x, y)
{
  R atomp (x) && atomp (y) ? x == y : 0;
}

ff (x)
{
  R atomp (x) ? x : ff (car (x));
}

subst (x, y, z)
{
  R atomp (z) ? (eq (z, y) ? x : z) :
    cons (subst (x, y, car (z)), subst (x, y, cdr (z)));
}

equal (x, y)
{
  R (atomp (x) && atomp (y) && eq (x, y))
    || (consp (x) && consp (y) && equal (car (x), car (y))
    && equal (cdr (x), cdr (y)));
}

null (x)
{
  R listp (x) && (val (x) == 0);
}

lista (int c, int *a)
{
  int z = NIL;
  for (; c;)
    z = cons (a[--c], z);
  R z;
}

listn (int c, ...)
{
  va_list a;
  int *z = n;
  va_start (a, c);
  for (; c--;)
    *n++ = va_arg (a, int);
  va_end (a);
  c = n - z;
  R lista (c, z);
}

#define list(...) listn(PP_NARG(__VA_ARGS__),__VA_ARGS__)
append (x, y)
{
  R null (x) ? y : cons (car (x), append (cdr (x), y));
}

among (x, y)
{
  R ! null (y) && equal (x, car (y)) || among (x, cdr (y));
}

pair (x, y)
{
  R null (x) && null (y) ? NIL :
    consp (x)
    && consp (y) ? cons (list (car (x), car (y)),
             pair (cdr (x), cdr (y))) : 0;
}

assoc (x, y)
{
  R eq (caar (y), x) ? cadar (y) : assoc (x, cdr (y));
}

sub2 (x, z)
{
  R null (x) ? z : eq (caar (x), z) ? cadar (x) : sub2 (cdr (x), z);
}

sublis (x, y)
{
  R atom (y) ? sub2 (x, y) : cons (sublis (x, car (y)), sublis (x, cdr (y)));
}

apply (f, args)
{
  R eval (cons (f, appq (args)), NIL);
}

appq (m)
{
  R null (m) ? NIL : cons (list (atom ('Q'), car (m)), appq (cdr (m)));
}

eval (e, a)
{
  R numberp (e) ? e :
    atomp (e) ? assoc (e, a) :
    atomp (car (e)) ? ( /*QUOTE*/ eq (car (e), atom ('Q')) ? cadr (e) :
               /*ATOM*/ eq (car (e),
                    atom ('A')) ? atomp (eval (cadr (e),
                                   a)) : /*EQ*/
               eq (car (e), atom ('E')) ? eval (cadr (e),
                            a) == eval (caddr (e),
                                    a) :
               /*COND*/ eq (car (e), atom ('D')) ? evcon (cdr (e),
                                  a) : /*CAR*/
               eq (car (e),
               atom ('H')) ? car (eval (cadr (e),
                            a)) : /*CDR*/ eq (car (e),
                                      atom
                                      ('R')) ?
               cdr (eval (cadr (e), a)) : /*CONS*/ eq (car (e),
                                   atom ('C')) ?
               cons (eval (cadr (e), a), eval (caddr (e), a)) :
               //eval(cons(assoc(car(e),a),evlis(cdr(e),a)),a) ):/*cf. Roots of Lisp*/
               eval (cons (assoc (car (e), a), cdr (e)), a)) :
    eq (caar (e), atom ('M')) ? /*LABEL*/
    eval (cons (caddar (e), cdr (e)), cons (list (cadar (e), car (e)), a)) :
    eq (caar (e), atom ('L')) ? /*LAMBDA*/
    eval (caddar (e), append (pair (cadar (e), evlis (cdr (e), a)), a)) : 0;
}

evcon (c, a)
{
  R eval (caar (c), a) ? eval (cadar (c), a) : evcon (cdr (c), a);
}

evlis (m, a)
{
  R null (m) ? NIL : cons (eval (car (m), a), evlis (cdr (m), a));
}

maplist (x, f)
{
  R null (x) ? NIL : cons (apply (f, x), maplist (cdr (x), f));
}

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)), prn (cdr (x)), printf (") ") : 0    //printf("NIL ")
    ;
}

#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, z);
      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));
}

void
fix (x)
{
  signal (SIGSEGV, fix);
  sbrk (msz);
  msz *= 2;
}

int
main ()
{
  assert ((-1 >> 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 (Q X)))";
  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的要点，测试部分.

Here's the guts of main again, the testing portion.

    char *s="(Q (A (Q X)))";
    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 (Q X)))
( 'Q' ( 'A' ( 'Q' 'X' ) ) ) 
EVAL
x: -75
0: 37777777665
0x: ffffffb5
tag(x): 1
val(x): -19
car(x): 0
cdr(x): 0
'A' 

推荐答案

您的阅读器有误，并且您的打印机在骗你.

Your reader is wrong, and your printer is lying to you.

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

Hint: try reading a list with more than one element, like (1 2 3 4 5).

问题是rd用 调用append，它只是作为第二个参数读取. (已修复该问题，已注释掉.)在上面的测试用例中，它恰好只是一个列表本身，因此append起作用.但是您实际传递给eval的基准实际上是

The problem is that rd calls append with the element it just read as the second argument. (The fix is already there, commented out.) In the test case above, that just happens to be a list itself, so append works. But the datum you're actually passing to eval is actually

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

正确打印时，或

(Q A Q . X)

带有标准列表缩写.

所以是的，eval返回A，这是正确的答案，除非您要检查是否没有意外的条件.

And so yes, eval returns A, which is the right answer, unless you want to check that there are no unexpected terms.

打印机中的错误是，成对打印cdr就像将其作为元素一样.您应该在汽车和CDR之间打印一个点，或者编写一个辅助功能prnlst来执行缩写列表打印.

The bug in the printer is that for pairs you print the cdr as if it were an element. You should print a dot between the car and the cdr, or you should write a helper function prnlst that does the abbreviated list printing.

这篇关于为什么我那小小的口齿不清的QUOTE?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！