システムプログラム01-ver01


※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

#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;
Ptr quote_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 if(CAR(x)==quote_pointer){
        fprintf(stdout, "\'");
        x=CDR(x);
        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){}
        else{}}
    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;
            case '\'':return cons(quote_pointer,cons(read_expr(),nil_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(")");
    quote_pointer=intern("quote");
    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");}