システムプログラム01-ver00 - ほかんじょ

#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>

#define LIST 00
#define SYMBOL 01

typedef struct ptr{
int tag;
union{
struct cell{
struct ptr*car;
struct ptr*cdr;
}cell;
struct symbol{
char *pname;
struct ptr*plist;
}symbol;
long int intv;
}atr;
}*Ptr;

Ptr oblist=NULL;
Ptr true_pointer;
Ptr nil_pointer;
Ptr dot_pointer;
Ptr rpar_pointer;
char* pname(Ptr x) {return x->atr.symbol.pname;}

Ptr symbolp(Ptr x)
{ if((x->tag)==SYMBOL)return true_pointer;
else return nil_pointer;
}

Ptr CAR(Ptr x) {return x->atr.cell.car;}
Ptr CDR(Ptr x) {return x->atr.cell.cdr;}
Ptr print_expr(Ptr x)
{if(symbolp(x)==true_pointer){
fprintf(stdout, "%s",pname(x));
}else{
fprintf(stdout, "(");
print_expr(CAR(x));
x=CDR(x);
while(symbolp(x)==nil_pointer){
fprintf(stdout," ");
print_expr(CAR(x));
x=CDR(x);}
if(x==nil_pointer){
fprintf(stdout,")");
}else{
fprintf(stdout," . %s)",pname(x));
}}
return nil_pointer;}
Ptr new_ptr()
{Ptr p;
p=(Ptr)malloc(sizeof(struct ptr));
if(p==NULL)exit(1);
return p;}

char *copy_string(char*s)
{char*p;
p=malloc(strlen(s)+1);
strcpy(p,s);
return p;}

Ptr new_symbol(char *pname)
{Ptr x;
x=new_ptr();
x->tag=SYMBOL;
x->atr.symbol.pname=copy_string(pname);
x->atr.symbol.plist=nil_pointer;
return x;}

Ptr cons(Ptr x, Ptr y)
{Ptr z;
z=new_ptr();
z->tag=LIST;
z->atr.cell.car=x;
z->atr.cell.cdr=y;
return z;}




Ptr intern(char* s)
{Ptr p=oblist;
Ptr id;
while(p!=NULL&&p!=nil_pointer){
if(strcmp(s,pname(CAR(p)))==0){
return CAR(p);
}
p=CDR(p);
}
oblist=cons(id=new_symbol(s),oblist);
return id;
}
char buf[100];

Ptr read_atom(int ch)
{int i=0;
buf[i++]=ch;
while(isalnum(ch=getchar()))buf[i++]=ch;
ungetc(ch,stdin);
buf[i]=0;
return intern(buf);}

Ptr read_expr();

Ptr read_expr_list()
{Ptr p;
p=read_expr();
if(p==rpar_pointer)return nil_pointer;
if(p==dot_pointer){p=read_expr();read_expr();return p;}
return cons(p, read_expr_list());}

Ptr read_expr()
{int ch;
while(isspace(ch=getchar()));
if(ch!=EOF){
if(isalnum(ch)) return read_atom(ch);
switch(ch){
case '(':return read_expr_list();
case '.':return dot_pointer;
case ')':return rpar_pointer;
default:fprintf(stderr,"unknown input");
return nil_pointer;
}
}else{
exit(0);
}
}



void main()
{Ptr x,y,z,w;
nil_pointer=intern("nil");
nil_pointer->atr.symbol.plist=nil_pointer;
oblist->atr.cell.cdr=nil_pointer;
true_pointer=intern("t");
printf("%p %p\n", nil_pointer, true_pointer);
dot_pointer=intern(".");
rpar_pointer=intern(")");
x=new_symbol("X");
y=new_symbol("Y");
z=cons(y,nil_pointer);
w=cons(x,y);
z=cons(w,z);
z=cons(x,z);
print_expr(z);
printf("\n");

z=read_expr();
printf("z=%p\n",z);
print_expr(z);
printf("\n");}