Skip to content

Instantly share code, notes, and snippets.

@sasagawa888
Created December 29, 2011 09:48
Show Gist options
  • Save sasagawa888/1533262 to your computer and use it in GitHub Desktop.
Save sasagawa888/1533262 to your computer and use it in GitHub Desktop.
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);
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment