├── mlis.c ├── mlis.h ├── mlis2.c └── mlis2.h /mlis.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/monolis/ae192e372fdcb63b194cb0b8c6206c60506b203e/mlis.c -------------------------------------------------------------------------------- /mlis.h: -------------------------------------------------------------------------------- 1 | /* MonoLis (minimam Lisp interpreter) 2 | written by kenichi sasagawa 2016/1 3 | ver 0.01 4 | */ 5 | 6 | #define HEAPSIZE 10000000 7 | #define FREESIZE 50 8 | #define STACKSIZE 30000 9 | #define SYMSIZE 256 10 | #define BUFSIZE 256 11 | #define NIL 0 12 | #define T 4 13 | 14 | typedef enum tag {EMP,NUM,SYM,LIS,SUBR,FSUBR,FUNC} tag; 15 | typedef enum flag {FRE,USE} flag; 16 | 17 | 18 | struct cell { 19 | tag tag; 20 | flag flag; 21 | char *name; 22 | union{ 23 | int num; 24 | int bind; 25 | int ( *subr) (); 26 | } val; 27 | int car; 28 | int cdr; 29 | }; 30 | 31 | typedef struct cell cell; 32 | 33 | 34 | typedef enum toktype {LPAREN,RPAREN,QUOTE,DOT,NUMBER,SYMBOL,OTHER} toktype; 35 | typedef enum backtrack {GO,BACK} backtrack; 36 | 37 | struct token { 38 | char ch; 39 | backtrack flag; 40 | toktype type; 41 | char buf[BUFSIZE]; 42 | }; 43 | 44 | typedef struct token token; 45 | 46 | #define GET_CAR(addr) heap[addr].car 47 | #define GET_CDR(addr) heap[addr].cdr 48 | #define GET_NUMBER(addr) heap[addr].val.num 49 | #define GET_NAME(addr) heap[addr].name 50 | #define GET_TAG(addr) heap[addr].tag 51 | #define GET_BIND(addr) heap[addr].val.bind 52 | #define GET_SUBR(addr) heap[addr].val.subr 53 | #define GET_FLAG(addr) heap[addr].flag 54 | #define SET_TAG(addr,x) heap[addr].tag = x 55 | #define SET_CAR(addr,x) heap[addr].car = x 56 | #define SET_CDR(addr,x) heap[addr].cdr = x 57 | #define SET_NUMBER(addr,x) heap[addr].val.num = x 58 | #define SET_BIND(addr,x) heap[addr].val.bind = x 59 | #define SET_NAME(addr,x) heap[addr].name = (char *)malloc(SYMSIZE); strcpy(heap[addr].name,x); 60 | #define SET_SUBR(addr,x) heap[addr].val.subr = x 61 | #define IS_SYMBOL(addr) heap[addr].tag == SYM 62 | #define IS_NUMBER(addr) heap[addr].tag == NUM 63 | #define IS_LIST(addr) heap[addr].tag == LIS 64 | #define IS_NIL(addr) (addr == 0 || addr == 1) 65 | #define IS_SUBR(addr) heap[addr].tag == SUBR 66 | #define IS_FSUBR(addr) heap[addr].tag == FSUBR 67 | #define IS_FUNC(addr) heap[addr].tag == FUNC 68 | #define IS_EMPTY(addr) heap[addr].tag == EMP 69 | #define HAS_NAME(addr,x) strcmp(heap[addr].name,x) == 0 70 | #define SAME_NAME(addr1,addr2) strcmp(heap[addr1].name, heap[addr2].name) == 0 71 | #define EQUAL_STR(x,y) strcmp(x,y) == 0 72 | #define MARK_CELL(addr) heap[addr].flag = USE 73 | #define NOMARK_CELL(addr) heap[addr].flag = FRE 74 | #define USED_CELL(addr) heap[addr].flag == USE 75 | #define FREE_CELL(addr) heap[addr].flag == FRE 76 | 77 | 78 | //------pointer---- 79 | int ep; //environment pointer 80 | int hp; //heap pointer 81 | int sp; //stack pointer 82 | int fc; //free counter 83 | int ap; //arglist pointer 84 | 85 | //-------read-------- 86 | #define EOL '\n' 87 | #define TAB '\t' 88 | #define SPACE ' ' 89 | #define ESCAPE 033 90 | #define NUL '\0' 91 | 92 | //-------error code--- 93 | #define CANT_FIND_ERR 1 94 | #define ARG_SYM_ERR 2 95 | #define ARG_NUM_ERR 3 96 | #define ARG_LIS_ERR 4 97 | #define ARG_LEN0_ERR 5 98 | #define ARG_LEN1_ERR 6 99 | #define ARG_LEN2_ERR 7 100 | #define ARG_LEN3_ERR 8 101 | #define MALFORM_ERR 9 102 | #define CANT_READ_ERR 10 103 | #define ILLEGAL_OBJ_ERR 11 104 | 105 | //-------arg check code-- 106 | #define NUMLIST_TEST 1 107 | #define SYMBOL_TEST 2 108 | #define NUMBER_TEST 3 109 | #define LIST_TEST 4 110 | #define LEN0_TEST 5 111 | #define LEN1_TEST 6 112 | #define LEN2_TEST 7 113 | #define LEN3_TEST 8 114 | #define LENS1_TEST 9 115 | #define LENS2_TEST 10 116 | #define COND_TEST 11 117 | 118 | 119 | void initcell(void); 120 | int freshcell(void); 121 | void bindsym(int sym, int val); 122 | void assocsym(int sym, int val); 123 | int findsym(int sym); 124 | void cellprint(int addr); 125 | void heapdump(int start, int end); 126 | void markoblist(void); 127 | void markcell(int addr); 128 | void gbcmark(void); 129 | void gbcsweep(void); 130 | void clrcell(int addr); 131 | void gbc(void); 132 | void checkgbc(void); 133 | int car(int addr); 134 | int cdr(int addr); 135 | int cons(int car, int cdr); 136 | int caar(int addr); 137 | int cdar(int addr); 138 | int cadr(int addr); 139 | int caddr(int addr); 140 | int assoc(int sym, int lis); 141 | int length(int addr); 142 | int list(int addr); 143 | int makenum(int num); 144 | int makesym(char *name); 145 | void gettoken(void); 146 | int numbertoken(char buf[]); 147 | int symboltoken(char buf[]); 148 | int issymch(char c); 149 | int read(void); 150 | int readlist(void); 151 | void print(int addr); 152 | void printlist(int addr); 153 | int eval(int addr); 154 | void bindarg(int lambda, int arglist); 155 | void unbind(void); 156 | int atomp(int addr); 157 | int numberp(int addr); 158 | int symbolp(int addr); 159 | int listp(int addr); 160 | int nullp(int addr); 161 | int eqp(int addr1, int addr2); 162 | int symnamep(int addr, char *name); 163 | int evlis(int addr); 164 | int apply(int func, int arg); 165 | int subrp(int addr); 166 | int fsubrp(int addr); 167 | int functionp(int addr); 168 | void initsubr(void); 169 | void defsubr(char *symname, int(*func)(int)); 170 | void deffsubr(char *symname, int(*func)(int)); 171 | void bindfunc(char *name, tag tag, int(*func)(int)); 172 | void bindfunc1(char *name, int addr); 173 | void push(int pt); 174 | int pop(void); 175 | void argpush(int addr); 176 | void argpop(void); 177 | void error(int errnum, char *fun, int arg); 178 | void checkarg(int test, char *fun, int arg); 179 | int isnumlis(int arg); 180 | 181 | //---subr------- 182 | int f_plus(int addr); 183 | int f_minus(int addr); 184 | int f_mult(int addr); 185 | int f_div(int addr); 186 | int f_exit(int addr); 187 | int f_heapdump(int addr); 188 | int f_car(int addr); 189 | int f_cdr(int addr); 190 | int f_cons(int addr); 191 | int f_length(int addr); 192 | int f_list(int addr); 193 | int f_nullp(int addr); 194 | int f_atomp(int addr); 195 | int f_eq(int addr); 196 | int f_setq(int addr); 197 | int f_oblist(int addr); 198 | int f_defun(int addr); 199 | int f_if(int addr); 200 | int f_cond(int addr); 201 | int f_numeqp(int addr); 202 | int f_numberp(int addr); 203 | int f_symbolp(int addr); 204 | int f_listp(int addr); 205 | int f_greater(int addr); 206 | int f_eqgreater(int addr); 207 | int f_smaller(int addr); 208 | int f_eqsmaller(int addr); 209 | int f_gbc(int addr); 210 | int f_eval(int addr); 211 | int f_apply(int addr); 212 | int f_read(int addr); 213 | int f_print(int addr); 214 | int f_begin(int addr); 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | -------------------------------------------------------------------------------- /mlis2.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/monolis/ae192e372fdcb63b194cb0b8c6206c60506b203e/mlis2.c -------------------------------------------------------------------------------- /mlis2.h: -------------------------------------------------------------------------------- 1 | /* MonoLis (minimam Lisp interpreter) 2 | written by kenichi sasagawa 2016/3 3 | ver 0.02 4 | special thanks to Tsuyoshi Uema 5 | */ 6 | 7 | #define HEAPSIZE 10000000 8 | #define FREESIZE 50 9 | #define STACKSIZE 30000 10 | #define SYMSIZE 256 11 | #define BUFSIZE 256 12 | #define NIL 0 13 | #define T 6 14 | #define HASHTBSIZE 107 15 | 16 | typedef enum tag {EMP,NUM,SYM,LIS,SUBR,FSUBR,FUNC,MACRO} tag; 17 | typedef enum flag {FRE,USE} flag; 18 | 19 | 20 | typedef struct cell { 21 | tag tag; 22 | flag flag; 23 | char *name; 24 | union{ 25 | int num; 26 | int bind; 27 | int ( *subr) (); 28 | } val; 29 | int car; 30 | int cdr; 31 | } cell; 32 | 33 | 34 | typedef enum toktype {LPAREN,RPAREN,QUOTE,DOT,BACKQUOTE,COMMA,ATMARK,NUMBER,SYMBOL,OTHER} toktype; 35 | typedef enum backtrack {GO,BACK} backtrack; 36 | 37 | typedef struct token { 38 | char ch; 39 | backtrack flag; 40 | toktype type; 41 | char buf[BUFSIZE]; 42 | } token; 43 | 44 | 45 | #define GET_CAR(addr) heap[addr].car 46 | #define GET_CDR(addr) heap[addr].cdr 47 | #define GET_NUMBER(addr) heap[addr].val.num 48 | #define GET_NAME(addr) heap[addr].name 49 | #define GET_TAG(addr) heap[addr].tag 50 | #define GET_BIND(addr) heap[addr].val.bind 51 | #define GET_SUBR(addr) heap[addr].val.subr 52 | #define GET_FLAG(addr) heap[addr].flag 53 | #define SET_TAG(addr,x) heap[addr].tag = x 54 | #define SET_CAR(addr,x) heap[addr].car = x 55 | #define SET_CDR(addr,x) heap[addr].cdr = x 56 | #define SET_NUMBER(addr,x) heap[addr].val.num = x 57 | #define SET_BIND(addr,x) heap[addr].val.bind = x 58 | #define SET_NAME(addr,x) heap[addr].name = (char *)malloc(SYMSIZE); strcpy(heap[addr].name,x); 59 | #define SET_SUBR(addr,x) heap[addr].val.subr = x 60 | #define IS_SYMBOL(addr) heap[addr].tag == SYM 61 | #define IS_NUMBER(addr) heap[addr].tag == NUM 62 | #define IS_LIST(addr) heap[addr].tag == LIS 63 | #define IS_NIL(addr) (addr == 0 || addr == 1) 64 | #define IS_SUBR(addr) heap[addr].tag == SUBR 65 | #define IS_FSUBR(addr) heap[addr].tag == FSUBR 66 | #define IS_FUNC(addr) heap[addr].tag == FUNC 67 | #define IS_MACRO(addr) heap[addr].tag == MACRO 68 | #define IS_EMPTY(addr) heap[addr].tag == EMP 69 | #define HAS_NAME(addr,x) strcmp(heap[addr].name,x) == 0 70 | #define SAME_NAME(addr1,addr2) strcmp(heap[addr1].name, heap[addr2].name) == 0 71 | #define EQUAL_STR(x,y) strcmp(x,y) == 0 72 | #define MARK_CELL(addr) heap[addr].flag = USE 73 | #define NOMARK_CELL(addr) heap[addr].flag = FRE 74 | #define USED_CELL(addr) heap[addr].flag == USE 75 | #define FREE_CELL(addr) heap[addr].flag == FRE 76 | 77 | 78 | //------pointer---- 79 | int ep; //environment pointer 80 | int hp; //heap pointer 81 | int sp; //stack pointer 82 | int fc; //free counter 83 | int ap; //arglist pointer 84 | 85 | //-------read-------- 86 | #define EOL '\n' 87 | #define TAB '\t' 88 | #define SPACE ' ' 89 | #define ESCAPE 033 90 | #define NUL '\0' 91 | 92 | //-------error code--- 93 | #define CANT_FIND_ERR 1 94 | #define ARG_SYM_ERR 2 95 | #define ARG_NUM_ERR 3 96 | #define ARG_LIS_ERR 4 97 | #define ARG_LEN0_ERR 5 98 | #define ARG_LEN1_ERR 6 99 | #define ARG_LEN2_ERR 7 100 | #define ARG_LEN3_ERR 8 101 | #define MALFORM_ERR 9 102 | #define CANT_READ_ERR 10 103 | #define ILLEGAL_OBJ_ERR 11 104 | 105 | //-------arg check code-- 106 | #define NUMLIST_TEST 1 107 | #define SYMBOL_TEST 2 108 | #define NUMBER_TEST 3 109 | #define LIST_TEST 4 110 | #define LEN0_TEST 5 111 | #define LEN1_TEST 6 112 | #define LEN2_TEST 7 113 | #define LEN3_TEST 8 114 | #define LENS1_TEST 9 115 | #define LENS2_TEST 10 116 | #define COND_TEST 11 117 | 118 | 119 | void initcell(void); 120 | int freshcell(void); 121 | void bindsym(int sym, int val); 122 | void assocsym(int sym, int val); 123 | int findsym(int sym); 124 | int getsym(char *name, int index); 125 | int addsym(char *name, int index); 126 | int makesym1(char *name); 127 | int hash(char *name); 128 | void cellprint(int addr); 129 | void heapdump(int start, int end); 130 | void markoblist(void); 131 | void markcell(int addr); 132 | void gbcmark(void); 133 | void gbcsweep(void); 134 | void clrcell(int addr); 135 | void gbc(void); 136 | void checkgbc(void); 137 | int car(int addr); 138 | int cdr(int addr); 139 | int cons(int car, int cdr); 140 | int caar(int addr); 141 | int cdar(int addr); 142 | int cadr(int addr); 143 | int caddr(int addr); 144 | int cadar(int addr); 145 | int assoc(int sym, int lis); 146 | int length(int addr); 147 | int list(int addr); 148 | int append(int x, int y); 149 | int makenum(int num); 150 | int makesym(char *name); 151 | void gettoken(void); 152 | int numbertoken(char buf[]); 153 | int symboltoken(char buf[]); 154 | int issymch(char c); 155 | int read(void); 156 | int readlist(void); 157 | void print(int addr); 158 | void printlist(int addr); 159 | int eval(int addr); 160 | void bindarg(int lambda, int arglist); 161 | void unbind(void); 162 | int atomp(int addr); 163 | int numberp(int addr); 164 | int symbolp(int addr); 165 | int listp(int addr); 166 | int nullp(int addr); 167 | int eqp(int addr1, int addr2); 168 | int symnamep(int addr, char *name); 169 | int evlis(int addr); 170 | int apply(int func, int arg); 171 | int subrp(int addr); 172 | int fsubrp(int addr); 173 | int functionp(int addr); 174 | int macrop(int addr); 175 | void initsubr(void); 176 | void defsubr(char *symname, int(*func)(int)); 177 | void deffsubr(char *symname, int(*func)(int)); 178 | void bindfunc(char *name, tag tag, int(*func)(int)); 179 | void bindfunc1(char *name, int addr); 180 | void bindmacro(char *name, int addr); 181 | void push(int pt); 182 | int pop(void); 183 | void argpush(int addr); 184 | void argpop(void); 185 | void error(int errnum, char *fun, int arg); 186 | void checkarg(int test, char *fun, int arg); 187 | int isnumlis(int arg); 188 | 189 | //---subr------- 190 | int f_plus(int addr); 191 | int f_minus(int addr); 192 | int f_mult(int addr); 193 | int f_div(int addr); 194 | int f_exit(int addr); 195 | int f_heapdump(int addr); 196 | int f_car(int addr); 197 | int f_cdr(int addr); 198 | int f_cons(int addr); 199 | int f_length(int addr); 200 | int f_list(int addr); 201 | int f_append(int addr); 202 | int f_nullp(int addr); 203 | int f_atomp(int addr); 204 | int f_eq(int addr); 205 | int f_setq(int addr); 206 | int f_oblist(int addr); 207 | int f_defun(int addr); 208 | int f_defmacro(int arglist); 209 | int f_if(int addr); 210 | int f_cond(int addr); 211 | int f_numeqp(int addr); 212 | int f_numberp(int addr); 213 | int f_symbolp(int addr); 214 | int f_listp(int addr); 215 | int f_greater(int addr); 216 | int f_eqgreater(int addr); 217 | int f_smaller(int addr); 218 | int f_eqsmaller(int addr); 219 | int f_gbc(int addr); 220 | int f_eval(int addr); 221 | int f_apply(int addr); 222 | int f_read(int addr); 223 | int f_print(int addr); 224 | int f_begin(int addr); 225 | 226 | 227 | int quasi_transfer1(int x); 228 | int quasi_transfer2(int x, int n); 229 | int list2(int x, int y); 230 | int list3(int x, int y, int z); 231 | --------------------------------------------------------------------------------