c - 私の小さなリスプが引用しないのはなぜですか？

Question

私は、minilispのエンコーディング、McCarthy の論文( Roots of Lispによって修正されたもの) に基づいた micro-mini-lisp を作成し、 J Incunabulumに基づく (おそらく好ましくない) スタイルを使用しています。ここPP_NARGからマクロを使用します。私はまた、以前のプロジェクトであるcodegolf 化されたラムダ計算インタープリターにも刺激を受けました。このインタープリターは、 1999 年の ioccc Lisp インタープリターに不気味なほど似ていることが後でわかりました。特に、メモリアドレスを参照するためにポインターではなくカーソルを使用している点です。

リーダーコードを含め、ほとんどが機能しているようです。しかし、eval(ATOM(QUOTE X))は正しく yieldingTであり、eval(ATOM(QUOTE(X Y Z)))正しく yieldingNILであり、かつeval(QUOTE X)yieldsXであり、かつeval(QUOTE(X Y Z))yields(X Y Z)です。奇妙な結果は、完全な部分式ではなく、eval(QUOTE(ATOM(QUOTE X)))yieldsです。ATOMATOM(QUOTE X)

私はそれがロングショットだと思います、そして私はそれを簡単にはしませんでしたが、誰かが引用のどこが間違っているのかを理解するのを手伝ってくれますか?

ところで、上記の説明とは異なり、インタープリターは 1 文字のトークンに限定されているため、QUOTEisQおよびATOMisAです。(ギットハブ)

/*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これが、テスト部分の内臓です。

    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'

score 4 · Accepted Answer

あなたのリーダーは間違っており、プリンターはあなたに嘘をついています。

ヒント: のように、複数の要素を含むリストを読んでみてください(1 2 3 4 5)。

問題は、読み取ったばかりの要素rdを 2 番目の引数として呼び出すことです。(修正は既にあり、コメントアウトされています。) 上記のテストケースでは、たまたまリスト自体であるため、機能します。しかし、実際に渡しているデータムは実際にはappendappendeval

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

正しく印刷された場合、または

(Q A Q . X)

標準のリストの省略形を使用します。

したがって、予期しない用語がないことを確認したい場合を除き、正しい答えであるをeval返します。A

プリンターのバグは、ペアの場合、cdr を要素であるかのように出力することです。car と cdr の間にドットを出力するかprnlst、省略されたリストの出力を行うヘルパー関数を作成する必要があります。

score -1 · Accepted Answer

それは完全に正しいです：

サブ表現

(QUOTE(ATOM(QUOTE X)))

は

(ATOM 'X)

と

(eval (atom 'x))

は

'X

（真実）

c - 私の小さなリスプが引用しないのはなぜですか？

3 に答える 3

Related

Reference