poly.h

poly.h

/* Poly (simple Scheme interpreter)
written by kenichi sasagawa 2011/12

*/ 

#define CELLSIZE 	1000000
#define HEAPSIZE	 799999
#define CONTSTK		 800000
#define PALASTK		 900000
#define FREESIZE       50
#define STACKSIZE  	300
#define SYMSIZE	64
#define BUFSIZE 256
#define NIL		0
#define BOOLT	2
#define BOOLF	5

//-------error code---
#define CANT_FIND_ERR	1
#define ARG_SYM_ERR		2
#define ARG_NUM_ERR		3
#define ARG_LIS_ERR		4
#define ARG_LEN0_ERR	5
#define ARG_LEN1_ERR	6
#define ARG_LEN2_ERR	7
#define ARG_LEN3_ERR	8
#define MALFORM_ERR		9
#define ARG_INT_ERR		10
#define CANT_READ_ERR	11
#define ARG_CLOS_ERR	12
#define ARG_ATOM_ERR	13

//-------arg check code--
#define INTEGER_TEST	1
#define SYMBOL_TEST		2
#define NUMBER_TEST		3
#define LIST_TEST		4
#define LEN0_TEST		5
#define LEN1_TEST		6
#define LEN2_TEST		7
#define LEN3_TEST		8
#define LENS1_TEST		9
#define LENS2_TEST		10
#define COND_TEST		11
#define ATOM_TEST		12


typedef enum tag {EMP,INTN,FLTN,COMP,BIG,RAT,SYM,LIS,VEC,BOL,ADDR,SUBR,SYNT,CLOS} tag;
typedef enum flag {FRE,USE} flag;


struct cell {
	tag tag;
    flag flag;
	char *name;
	union{
    	int		integer;
		double	realnumber;
    	int 	bind;
		int 	( *subr) ();
    } real;
    union{
    	int 	integer;
        double	realnumber;
    } imag;
    int env; 
    int car;
    int cdr;
};

typedef struct cell cell;

typedef enum toktype {LPAREN,RPAREN,LBRAKET,RBRAKET,QUOTE,DOT,INTEGER,FLOAT_N,COMPLEX,SYMBOL,OTHER} toktype;
typedef enum backtrack {GO,BACK} backtrack;

struct token {
	char ch;
    backtrack flag;
	toktype type;
    char buf[BUFSIZE];
};

typedef struct token token;

#define GET_TAG(addr)		memory[addr].tag
#define GET_FLAG(addr)		memory[addr].flag
#define GET_NAME(addr)		memory[addr].name
#define GET_REAL_INT(addr)	memory[addr].real.integer
#define GET_REAL_FLT(addr)	memory[addr].real.float
#define GET_BIND(addr)		memory[addr].real.bind
#define GET_SUBR(addr)		memory[addr].real.subr
#define GET_IMAG_INT(addr)	memory[addr].imag.integer
#define GET_IMAG_FLT(addr)	memory[addr].imag.float
#define GET_CAR(addr)		memory[addr].car
#define GET_CDR(addr)		memory[addr].cdr
#define GET_ENV(addr)		memory[addr].env
#define SET_TAG(addr,x)		memory[addr].tag = x
#define SET_FLAG_FREE(addr)	memory[addr].flag = free
#define SET_FLAG_USE(addr)	memory[addr].flag = USE
#define SET_NAME(addr,x)	memory[addr].name = (char *)malloc(SYMSIZE); strcpy(memory[addr].name,x);
#define SET_REAL_INT(addr,x) 	memory[addr].real.integer = x
#define SET_REAL_FLT(addr,x) 	memory[addr].real.float = x
#define SET_BIND(addr,x)	memory[addr].real.bind = x
#define SET_SUBR(addr,x)	memory[addr].real.subr = (int (*)())x
#define SET_ENV(addr,x)		memory[addr].env = x
#define SET_CAR(addr,x)		memory[addr].car = x
#define SET_CDR(addr,x)		memory[addr].cdr = x
#define IS_EMPTY(addr)		memory[addr].tag	== EMP
#define IS_SYMBOL(addr)		memory[addr].tag == SYM
#define IS_INTEGER(addr)	memory[addr].tag == INTN
#define IS_FLOAT(addr)		memory[addr].tag == FLTN
#define IS_COMPLEX(addr)	memory[addr].tag == COMP
#define IS_LIST(addr)		memory[addr].tag == LIS
#define IS_NIL(addr)		memory[addr].tag == SYM && HAS_NAME(addr,"nil")
#define IS_SUBR(addr)		memory[addr].tag == SUBR
#define IS_ADDR(addr)		memory[addr].tag == ADDR
#define IS_CLOSURE(addr)	memory[addr].tag == CLOS
#define IS_BOOL(addr)		memory[addr].tag == BOL
#define iS_T(addr)			memory[addr].tag == BOL && HAS_NAME(addr,"#t")
#define IS_F(addr)			memory[addr].tag == BOL && HAS_NAME(addr,"#f")
#define HAS_NAME(addr,x)	strcmp(memory[addr].name,x) == 0
#define SAME_NAME(addr1,addr2) strcmp(memory[addr1].name, memory[addr2].name) == 0
#define EQUAL_STR(x,y)		strcmp(x,y) == 0
#define DEBUG				printf("debug\n"); longjmp(buf,1);

//------register----
int E; //global environment pointer
int H; //heap pointer 
int S; //stack pointer
int F; //free count
int CS; //consume of S
int A; //arglist pointer
int P; //continuation stack pointer
int CP; //sonsume of P

//-------read--------
#define EOL		'\n'
#define TAB		'\t'
#define SPACE	' '
#define ESCAPE	033
#define NUL		'\0'


void memorydump(int start, int end);
void stackdump(int start, int end);
void argstkdump(int start, int end);

void initcell(void);
void freestack(void);
int freshcell(void);
int freshstk(void);
void copycell(int x, int y);
void bindsym(int sym, int env);
int assocsym(int sym, int env);
int definesym(int sym, int env);
int findsym(int sym, int env);
void bindenv(int pala, int env);
void unbindenv(int pala, int env);
void pushpala(int x);
void poppala(int x);
void pushcont(int x);
void popcont(int x);
void darumapala(int x, int addr);
void darumacont(int x, int addr);
int poparg(void);
void pushint(int n);
void pushsym(char *name);
void pushbool(char *name);


int car(int lis);
int caar(int lis);
int cdar(int lis);
int cdr(int lis);
int cddr(int list);
int cadr(int lis);
int caddr(int lis);
int cons(int car, int cdr);
int assoc(int sym, int lis);
int length(int lis);
int list(int arglist);
int improperp(int x);
int reverse(int list);
int reverse2(int lis);
int atomp(int x);
int integerp(int x);
int numberp(int x);
int symbolp(int x);
int listp(int x);
int pairp(int x);
int nullp(int x);
int numeqp(int num1, int num2);
int eqp(int x1, int x2);
int eqvp(int x1, int x2);
int equalp(int x1, int x2);
void evalstk(int env);
void eval(int x, int env);
int getvar(int x, int env);
void apply(int sym, int args, int env);
int makeenv(int arg, int env);

void gettoken(void);
int numbertoken(char buf[]);
int symboltoken(char buf[]);
int issymch(char c);
void readstk(void);
int read(void);
int readlist(void);
void printstk(void);
void print(int x);
void printlist(int x);

void error(int errnum, char *fun, int arg);
void checkarg(int test, char *fun, int arg);

void defsubr(char *symname, int func);
void defsyntax(char *symname, int func);
void bindfunc(char *name, tag tag, int func);
void initsubr(void);
void f_exit(void);
void f_memorydump(void);
void f_addr(void);
void f_register(void);
void f_listcc(void);
void f_listp(void);
void f_pairp(void);
void f_boolp(void);
void f_atomp(void);
void f_symbolp(void);
void f_eqp(void);
void f_eqvp(void);
void f_equalp(void);
void f_procedurep(void);
void f_plus(void);
void f_minus(void);
void f_mult(void);
void f_numeqp(void);
void f_eqsmallerp(void);
void f_display(void);
void f_car(void);
void f_cdr(void);
void f_cons(void);
void f_caar(void);
void f_caaar(void);
void f_cdar(void);
void f_cddr(void);
void f_cadr(void);
void f_caddr(void);
void f_assoc(void);
void f_reverse(void);
void f_reverse2(void);
void f_newline(void);

void s_quote(int arg, int env);
void s_define(int arg, int env);
void s_if(int arg, int env);
void s_lambda(int arg, int env);
void s_begin(int arg, int env);
void s_setq(int arg, int env);