Lisp Interpreter for mbed LPC1768
Lisp Interpreter
(Marc Adler Lisp Interpreter, malisp)
mbed LPC1768 port by Takehisa Oneta (ohneta@gmail.com)
malisp.cpp@1:a2955606adef, 2016-05-21 (annotated)
- Committer:
- ohneta
- Date:
- Sat May 21 22:26:40 2016 +0000
- Revision:
- 1:a2955606adef
- Parent:
- 0:e9a7a38d9ad3
??commit
Who changed what in which revision?
User | Revision | Line number | New contents of line |
---|---|---|---|
ohneta | 0:e9a7a38d9ad3 | 1 | #include "mbed.h" |
ohneta | 0:e9a7a38d9ad3 | 2 | |
ohneta | 0:e9a7a38d9ad3 | 3 | #include <stdio.h> |
ohneta | 0:e9a7a38d9ad3 | 4 | #include <stdlib.h> |
ohneta | 0:e9a7a38d9ad3 | 5 | #include <ctype.h> |
ohneta | 0:e9a7a38d9ad3 | 6 | #include <string.h> |
ohneta | 0:e9a7a38d9ad3 | 7 | #include "malisp.h" |
ohneta | 0:e9a7a38d9ad3 | 8 | #include "mbed_functions.h" |
ohneta | 0:e9a7a38d9ad3 | 9 | |
ohneta | 0:e9a7a38d9ad3 | 10 | extern Serial pc; |
ohneta | 0:e9a7a38d9ad3 | 11 | extern DigitalOut led1; |
ohneta | 0:e9a7a38d9ad3 | 12 | extern DigitalOut led2; |
ohneta | 0:e9a7a38d9ad3 | 13 | extern DigitalOut led3; |
ohneta | 0:e9a7a38d9ad3 | 14 | extern DigitalOut led4; |
ohneta | 0:e9a7a38d9ad3 | 15 | extern char *lisplib; |
ohneta | 0:e9a7a38d9ad3 | 16 | |
ohneta | 0:e9a7a38d9ad3 | 17 | int _stack = 5000; |
ohneta | 0:e9a7a38d9ad3 | 18 | |
ohneta | 0:e9a7a38d9ad3 | 19 | LIST *TRU; |
ohneta | 0:e9a7a38d9ad3 | 20 | LIST *g_alist; // 連想リスト |
ohneta | 0:e9a7a38d9ad3 | 21 | LIST *g_oblist; // list of Lisp Functions |
ohneta | 0:e9a7a38d9ad3 | 22 | |
ohneta | 0:e9a7a38d9ad3 | 23 | char progon; |
ohneta | 0:e9a7a38d9ad3 | 24 | |
ohneta | 0:e9a7a38d9ad3 | 25 | //FILE *fd; // input file descriptor |
ohneta | 0:e9a7a38d9ad3 | 26 | FILE_MINE fd; |
ohneta | 0:e9a7a38d9ad3 | 27 | |
ohneta | 0:e9a7a38d9ad3 | 28 | int32_t getc_mine_buffer_pt = 0; |
ohneta | 0:e9a7a38d9ad3 | 29 | int getc_mine_buffer[8]; |
ohneta | 0:e9a7a38d9ad3 | 30 | uint32_t lisplib_counter = 0; |
ohneta | 0:e9a7a38d9ad3 | 31 | |
ohneta | 0:e9a7a38d9ad3 | 32 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 33 | //int getc_mine(FILE *fd) |
ohneta | 0:e9a7a38d9ad3 | 34 | int getc_mine(FILE_MINE fd) |
ohneta | 0:e9a7a38d9ad3 | 35 | { |
ohneta | 0:e9a7a38d9ad3 | 36 | if (getc_mine_buffer_pt > 0) { |
ohneta | 0:e9a7a38d9ad3 | 37 | int c = getc_mine_buffer[getc_mine_buffer_pt]; |
ohneta | 0:e9a7a38d9ad3 | 38 | getc_mine_buffer_pt--; |
ohneta | 0:e9a7a38d9ad3 | 39 | if (getc_mine_buffer_pt < 0) { |
ohneta | 0:e9a7a38d9ad3 | 40 | getc_mine_buffer_pt = 0; |
ohneta | 0:e9a7a38d9ad3 | 41 | } |
ohneta | 0:e9a7a38d9ad3 | 42 | return c; |
ohneta | 0:e9a7a38d9ad3 | 43 | } |
ohneta | 0:e9a7a38d9ad3 | 44 | |
ohneta | 0:e9a7a38d9ad3 | 45 | //return getc(fd); |
ohneta | 0:e9a7a38d9ad3 | 46 | |
ohneta | 0:e9a7a38d9ad3 | 47 | int c = 0; |
ohneta | 0:e9a7a38d9ad3 | 48 | if (fd == FILE_SERIAL) { |
ohneta | 0:e9a7a38d9ad3 | 49 | c = pc.getc(); |
ohneta | 0:e9a7a38d9ad3 | 50 | //pc.putc(c); |
ohneta | 0:e9a7a38d9ad3 | 51 | |
ohneta | 0:e9a7a38d9ad3 | 52 | } else if (fd == FILE_STRING) { |
ohneta | 0:e9a7a38d9ad3 | 53 | |
ohneta | 0:e9a7a38d9ad3 | 54 | if (lisplib_counter > strlen(lisplib)) { |
ohneta | 0:e9a7a38d9ad3 | 55 | c = EOF; // EOF |
ohneta | 0:e9a7a38d9ad3 | 56 | } else { |
ohneta | 0:e9a7a38d9ad3 | 57 | c = *(lisplib + lisplib_counter); |
ohneta | 0:e9a7a38d9ad3 | 58 | lisplib_counter++; |
ohneta | 0:e9a7a38d9ad3 | 59 | } |
ohneta | 0:e9a7a38d9ad3 | 60 | } |
ohneta | 0:e9a7a38d9ad3 | 61 | |
ohneta | 0:e9a7a38d9ad3 | 62 | return c; |
ohneta | 0:e9a7a38d9ad3 | 63 | } |
ohneta | 0:e9a7a38d9ad3 | 64 | |
ohneta | 0:e9a7a38d9ad3 | 65 | //void ungetc_mine(int c, FILE *fd) |
ohneta | 0:e9a7a38d9ad3 | 66 | void ungetc_mine(int c, FILE_MINE fd) |
ohneta | 0:e9a7a38d9ad3 | 67 | { |
ohneta | 0:e9a7a38d9ad3 | 68 | getc_mine_buffer_pt++; |
ohneta | 0:e9a7a38d9ad3 | 69 | getc_mine_buffer[getc_mine_buffer_pt] = c; |
ohneta | 0:e9a7a38d9ad3 | 70 | } |
ohneta | 0:e9a7a38d9ad3 | 71 | |
ohneta | 0:e9a7a38d9ad3 | 72 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 73 | // main program |
ohneta | 0:e9a7a38d9ad3 | 74 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 75 | |
ohneta | 0:e9a7a38d9ad3 | 76 | void malisp_main() |
ohneta | 0:e9a7a38d9ad3 | 77 | { |
ohneta | 0:e9a7a38d9ad3 | 78 | initialize(); |
ohneta | 0:e9a7a38d9ad3 | 79 | pc.printf("\nMarc Adler's LISP Interpreter. (mbed port and expansion by ohneta)\n"); |
ohneta | 0:e9a7a38d9ad3 | 80 | load_library(); |
ohneta | 0:e9a7a38d9ad3 | 81 | |
ohneta | 0:e9a7a38d9ad3 | 82 | pc.printf("[FREE-MEM: %d bytes]\n", _getFreeMemorySize()); |
ohneta | 0:e9a7a38d9ad3 | 83 | |
ohneta | 0:e9a7a38d9ad3 | 84 | { |
ohneta | 0:e9a7a38d9ad3 | 85 | fd = FILE_SERIAL; |
ohneta | 0:e9a7a38d9ad3 | 86 | getc_mine_buffer_pt = 0; |
ohneta | 0:e9a7a38d9ad3 | 87 | interpret_malisp(); |
ohneta | 0:e9a7a38d9ad3 | 88 | } |
ohneta | 0:e9a7a38d9ad3 | 89 | } |
ohneta | 0:e9a7a38d9ad3 | 90 | |
ohneta | 0:e9a7a38d9ad3 | 91 | void interpret_malisp() |
ohneta | 0:e9a7a38d9ad3 | 92 | { |
ohneta | 0:e9a7a38d9ad3 | 93 | LIST *p = NULL; |
ohneta | 0:e9a7a38d9ad3 | 94 | LIST *q = NULL; |
ohneta | 0:e9a7a38d9ad3 | 95 | int c; |
ohneta | 0:e9a7a38d9ad3 | 96 | |
ohneta | 0:e9a7a38d9ad3 | 97 | while (EOF != (c = gettok())) { |
ohneta | 0:e9a7a38d9ad3 | 98 | if (c == ERR) { |
ohneta | 0:e9a7a38d9ad3 | 99 | continue; |
ohneta | 0:e9a7a38d9ad3 | 100 | } |
ohneta | 0:e9a7a38d9ad3 | 101 | |
ohneta | 0:e9a7a38d9ad3 | 102 | switch (c) { |
ohneta | 0:e9a7a38d9ad3 | 103 | case LPAREN: |
ohneta | 0:e9a7a38d9ad3 | 104 | getc_mine(fd); // span the paren |
ohneta | 0:e9a7a38d9ad3 | 105 | q = makelist(); |
ohneta | 0:e9a7a38d9ad3 | 106 | p = eval(q, g_alist); |
ohneta | 0:e9a7a38d9ad3 | 107 | break; |
ohneta | 0:e9a7a38d9ad3 | 108 | |
ohneta | 0:e9a7a38d9ad3 | 109 | case LETTER: |
ohneta | 0:e9a7a38d9ad3 | 110 | p = cdr(car(getid())); |
ohneta | 0:e9a7a38d9ad3 | 111 | break; |
ohneta | 0:e9a7a38d9ad3 | 112 | } |
ohneta | 0:e9a7a38d9ad3 | 113 | |
ohneta | 0:e9a7a38d9ad3 | 114 | if (fd == FILE_SERIAL) { |
ohneta | 0:e9a7a38d9ad3 | 115 | pc.printf("\n"); |
ohneta | 0:e9a7a38d9ad3 | 116 | pc.printf("value => "); |
ohneta | 0:e9a7a38d9ad3 | 117 | if (p == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 118 | pc.printf("nil"); |
ohneta | 0:e9a7a38d9ad3 | 119 | } else { |
ohneta | 0:e9a7a38d9ad3 | 120 | lisp_print(cons(p, NULL)); |
ohneta | 0:e9a7a38d9ad3 | 121 | //lisp_print(p); |
ohneta | 0:e9a7a38d9ad3 | 122 | } |
ohneta | 0:e9a7a38d9ad3 | 123 | pc.printf("\n"); |
ohneta | 0:e9a7a38d9ad3 | 124 | } |
ohneta | 0:e9a7a38d9ad3 | 125 | } |
ohneta | 0:e9a7a38d9ad3 | 126 | } |
ohneta | 0:e9a7a38d9ad3 | 127 | |
ohneta | 0:e9a7a38d9ad3 | 128 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 129 | // initialization procedures |
ohneta | 0:e9a7a38d9ad3 | 130 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 131 | |
ohneta | 0:e9a7a38d9ad3 | 132 | void initialize() |
ohneta | 0:e9a7a38d9ad3 | 133 | { |
ohneta | 0:e9a7a38d9ad3 | 134 | init("'", QUOTE); |
ohneta | 0:e9a7a38d9ad3 | 135 | init("car", FCAR); |
ohneta | 0:e9a7a38d9ad3 | 136 | init("cond", COND); |
ohneta | 0:e9a7a38d9ad3 | 137 | init("cdr", FCDR); |
ohneta | 0:e9a7a38d9ad3 | 138 | init("defun", DEFUN); |
ohneta | 0:e9a7a38d9ad3 | 139 | init("cons",FCONS); |
ohneta | 0:e9a7a38d9ad3 | 140 | init("nil", NILL); |
ohneta | 0:e9a7a38d9ad3 | 141 | init("atom",FATOM); |
ohneta | 0:e9a7a38d9ad3 | 142 | init("prog",PROG); |
ohneta | 0:e9a7a38d9ad3 | 143 | init("eq", FEQ); |
ohneta | 0:e9a7a38d9ad3 | 144 | init("go", GO); |
ohneta | 0:e9a7a38d9ad3 | 145 | init("setq",FSETQ); |
ohneta | 0:e9a7a38d9ad3 | 146 | init("return",RETRN); |
ohneta | 0:e9a7a38d9ad3 | 147 | init("print",PRINT); |
ohneta | 0:e9a7a38d9ad3 | 148 | init("read", FREAD); |
ohneta | 0:e9a7a38d9ad3 | 149 | init("rplaca",FREPLACA); |
ohneta | 0:e9a7a38d9ad3 | 150 | init("rplacd",FREPLACD); |
ohneta | 0:e9a7a38d9ad3 | 151 | init("apply", FAPPLY); |
ohneta | 0:e9a7a38d9ad3 | 152 | init("eval", FEVAL); |
ohneta | 0:e9a7a38d9ad3 | 153 | init("and", FAND); |
ohneta | 0:e9a7a38d9ad3 | 154 | init("or", FOR); |
ohneta | 0:e9a7a38d9ad3 | 155 | init("not", FNOT); |
ohneta | 0:e9a7a38d9ad3 | 156 | init("plus", PLUS); |
ohneta | 0:e9a7a38d9ad3 | 157 | init("zerop", ZEROP); |
ohneta | 0:e9a7a38d9ad3 | 158 | init("diff", DIFF); |
ohneta | 0:e9a7a38d9ad3 | 159 | init("greaterp", GREATERP); |
ohneta | 0:e9a7a38d9ad3 | 160 | init("times", TIMES); |
ohneta | 0:e9a7a38d9ad3 | 161 | init("lessp", LESSP); |
ohneta | 0:e9a7a38d9ad3 | 162 | init("add1", ADD1); |
ohneta | 0:e9a7a38d9ad3 | 163 | init("sub1", SUB1); |
ohneta | 0:e9a7a38d9ad3 | 164 | init("quot", QUOTIENT); |
ohneta | 1:a2955606adef | 165 | TRU = cons(init("t", T), NULL); |
ohneta | 1:a2955606adef | 166 | init("numberp", NUMBERP); |
ohneta | 0:e9a7a38d9ad3 | 167 | rplact(TRU, SATOM); |
ohneta | 0:e9a7a38d9ad3 | 168 | init("null", NUL); |
ohneta | 0:e9a7a38d9ad3 | 169 | init("funcall",FUNCALL); |
ohneta | 0:e9a7a38d9ad3 | 170 | |
ohneta | 0:e9a7a38d9ad3 | 171 | // for mbed functions |
ohneta | 0:e9a7a38d9ad3 | 172 | init("info", FINFO); |
ohneta | 0:e9a7a38d9ad3 | 173 | init("freemem", FFREEMEM); |
ohneta | 1:a2955606adef | 174 | |
ohneta | 0:e9a7a38d9ad3 | 175 | init("wait", FWAIT); |
ohneta | 0:e9a7a38d9ad3 | 176 | init("dout", FDOUT); |
ohneta | 0:e9a7a38d9ad3 | 177 | init("din", FDIN); |
ohneta | 0:e9a7a38d9ad3 | 178 | init("aout", FAOUT); |
ohneta | 0:e9a7a38d9ad3 | 179 | init("ain", FAIN); |
ohneta | 0:e9a7a38d9ad3 | 180 | init("pwmout", PWMOUT); |
ohneta | 0:e9a7a38d9ad3 | 181 | |
ohneta | 0:e9a7a38d9ad3 | 182 | g_oblist = g_alist; |
ohneta | 0:e9a7a38d9ad3 | 183 | } |
ohneta | 0:e9a7a38d9ad3 | 184 | |
ohneta | 0:e9a7a38d9ad3 | 185 | LIST *init(char *name, int t) |
ohneta | 0:e9a7a38d9ad3 | 186 | { |
ohneta | 1:a2955606adef | 187 | LIST *p = install(name, false); |
ohneta | 1:a2955606adef | 188 | rplact(p, t); |
ohneta | 0:e9a7a38d9ad3 | 189 | |
ohneta | 0:e9a7a38d9ad3 | 190 | return p; |
ohneta | 0:e9a7a38d9ad3 | 191 | } |
ohneta | 0:e9a7a38d9ad3 | 192 | |
ohneta | 0:e9a7a38d9ad3 | 193 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 194 | // create the executable list form of a LISP program |
ohneta | 0:e9a7a38d9ad3 | 195 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 196 | |
ohneta | 0:e9a7a38d9ad3 | 197 | LIST *makelist() |
ohneta | 0:e9a7a38d9ad3 | 198 | { |
ohneta | 0:e9a7a38d9ad3 | 199 | LIST *p; |
ohneta | 0:e9a7a38d9ad3 | 200 | |
ohneta | 0:e9a7a38d9ad3 | 201 | switch (gettok()) { |
ohneta | 0:e9a7a38d9ad3 | 202 | case LPAREN: |
ohneta | 0:e9a7a38d9ad3 | 203 | getc_mine(fd); // span the paren ????? |
ohneta | 0:e9a7a38d9ad3 | 204 | p = makelist(); |
ohneta | 0:e9a7a38d9ad3 | 205 | p = cons(p, makelist()); |
ohneta | 0:e9a7a38d9ad3 | 206 | rplact(p, LST); |
ohneta | 0:e9a7a38d9ad3 | 207 | return p; |
ohneta | 0:e9a7a38d9ad3 | 208 | |
ohneta | 0:e9a7a38d9ad3 | 209 | case LETTER: |
ohneta | 0:e9a7a38d9ad3 | 210 | p = getid(); |
ohneta | 0:e9a7a38d9ad3 | 211 | return cons(p, makelist()); |
ohneta | 0:e9a7a38d9ad3 | 212 | |
ohneta | 0:e9a7a38d9ad3 | 213 | case INQUOTE: |
ohneta | 0:e9a7a38d9ad3 | 214 | p = getid(); |
ohneta | 0:e9a7a38d9ad3 | 215 | p = cons(p, makelist()); |
ohneta | 0:e9a7a38d9ad3 | 216 | rplaca(p, cons(car(p), cons(car(cdr(p)), NULL))); |
ohneta | 0:e9a7a38d9ad3 | 217 | rplacd(p, cdr(cdr(p))); |
ohneta | 0:e9a7a38d9ad3 | 218 | return p; |
ohneta | 0:e9a7a38d9ad3 | 219 | |
ohneta | 0:e9a7a38d9ad3 | 220 | case DIGIT: |
ohneta | 0:e9a7a38d9ad3 | 221 | p = getnum(); |
ohneta | 0:e9a7a38d9ad3 | 222 | return cons(p, makelist()); |
ohneta | 0:e9a7a38d9ad3 | 223 | |
ohneta | 0:e9a7a38d9ad3 | 224 | case RPAREN: |
ohneta | 0:e9a7a38d9ad3 | 225 | getc_mine(fd); // span rparen ?????? |
ohneta | 0:e9a7a38d9ad3 | 226 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 227 | } |
ohneta | 0:e9a7a38d9ad3 | 228 | |
ohneta | 0:e9a7a38d9ad3 | 229 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 230 | } |
ohneta | 0:e9a7a38d9ad3 | 231 | |
ohneta | 0:e9a7a38d9ad3 | 232 | |
ohneta | 0:e9a7a38d9ad3 | 233 | // isp_print - walks along the list structure printing atoms |
ohneta | 0:e9a7a38d9ad3 | 234 | void lisp_print(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 235 | { |
ohneta | 1:a2955606adef | 236 | if (p == NULL) { |
ohneta | 1:a2955606adef | 237 | return; |
ohneta | 1:a2955606adef | 238 | } |
ohneta | 1:a2955606adef | 239 | |
ohneta | 1:a2955606adef | 240 | if (type(p) == RATOM) { |
ohneta | 1:a2955606adef | 241 | pc.printf("%f ", p->u.num); |
ohneta | 1:a2955606adef | 242 | } else if (type(p) == IATOM) { |
ohneta | 1:a2955606adef | 243 | pc.printf("%d ", (int) p->u.num); |
ohneta | 1:a2955606adef | 244 | } else if (type(p) == SATOM) { |
ohneta | 1:a2955606adef | 245 | pc.printf("%s ", getname(car(p))); |
ohneta | 1:a2955606adef | 246 | } else if (type(car(p)) == LST) { |
ohneta | 1:a2955606adef | 247 | pc.printf("%c", '('); |
ohneta | 1:a2955606adef | 248 | lisp_print(car(p)); |
ohneta | 1:a2955606adef | 249 | pc.printf("%c", ')'); |
ohneta | 1:a2955606adef | 250 | lisp_print(cdr(p)); |
ohneta | 1:a2955606adef | 251 | } else if (type(p) == LST) { |
ohneta | 1:a2955606adef | 252 | lisp_print(car(p)); |
ohneta | 1:a2955606adef | 253 | lisp_print(cdr(p)); |
ohneta | 1:a2955606adef | 254 | } else { |
ohneta | 1:a2955606adef | 255 | pc.printf("******** can't print it out *******\n"); |
ohneta | 0:e9a7a38d9ad3 | 256 | } |
ohneta | 0:e9a7a38d9ad3 | 257 | } |
ohneta | 0:e9a7a38d9ad3 | 258 | |
ohneta | 0:e9a7a38d9ad3 | 259 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 260 | // evaluate a LISP function |
ohneta | 0:e9a7a38d9ad3 | 261 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 262 | |
ohneta | 0:e9a7a38d9ad3 | 263 | LIST *eval(LIST *x, LIST *alist) |
ohneta | 0:e9a7a38d9ad3 | 264 | { |
ohneta | 0:e9a7a38d9ad3 | 265 | LIST *p, *q; |
ohneta | 0:e9a7a38d9ad3 | 266 | int savt, t; |
ohneta | 0:e9a7a38d9ad3 | 267 | |
ohneta | 0:e9a7a38d9ad3 | 268 | if (x == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 269 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 270 | } |
ohneta | 0:e9a7a38d9ad3 | 271 | t = type(x); |
ohneta | 0:e9a7a38d9ad3 | 272 | if (t == VARI) { |
ohneta | 0:e9a7a38d9ad3 | 273 | return assoc(alist, getname(car(x))); |
ohneta | 0:e9a7a38d9ad3 | 274 | } |
ohneta | 0:e9a7a38d9ad3 | 275 | if (t == IATOM || t == RATOM) { |
ohneta | 0:e9a7a38d9ad3 | 276 | return x; |
ohneta | 0:e9a7a38d9ad3 | 277 | } |
ohneta | 0:e9a7a38d9ad3 | 278 | if (t == LABL) { |
ohneta | 0:e9a7a38d9ad3 | 279 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 280 | } |
ohneta | 0:e9a7a38d9ad3 | 281 | |
ohneta | 0:e9a7a38d9ad3 | 282 | switch (type(car(x))) { |
ohneta | 0:e9a7a38d9ad3 | 283 | case T: |
ohneta | 0:e9a7a38d9ad3 | 284 | return TRU; |
ohneta | 0:e9a7a38d9ad3 | 285 | |
ohneta | 0:e9a7a38d9ad3 | 286 | case NILL: |
ohneta | 0:e9a7a38d9ad3 | 287 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 288 | |
ohneta | 0:e9a7a38d9ad3 | 289 | case QUOTE: |
ohneta | 0:e9a7a38d9ad3 | 290 | var_to_atom(car(cdr(x))); |
ohneta | 0:e9a7a38d9ad3 | 291 | return car(cdr(x)); |
ohneta | 0:e9a7a38d9ad3 | 292 | |
ohneta | 0:e9a7a38d9ad3 | 293 | case FCAR: |
ohneta | 0:e9a7a38d9ad3 | 294 | return car(eval(cdr(x), alist)); |
ohneta | 0:e9a7a38d9ad3 | 295 | |
ohneta | 0:e9a7a38d9ad3 | 296 | case FCDR: |
ohneta | 0:e9a7a38d9ad3 | 297 | return cdr(eval(cdr(x), alist)); |
ohneta | 0:e9a7a38d9ad3 | 298 | |
ohneta | 0:e9a7a38d9ad3 | 299 | case FATOM: |
ohneta | 0:e9a7a38d9ad3 | 300 | return atom(eval(cdr(x), alist)); |
ohneta | 0:e9a7a38d9ad3 | 301 | |
ohneta | 0:e9a7a38d9ad3 | 302 | case FEQ: |
ohneta | 0:e9a7a38d9ad3 | 303 | return eq(eval(car(cdr(x)),alist), eval(cdr(cdr(x)),alist)); |
ohneta | 0:e9a7a38d9ad3 | 304 | |
ohneta | 0:e9a7a38d9ad3 | 305 | case NUL: |
ohneta | 0:e9a7a38d9ad3 | 306 | return eq(eval(car(cdr(x)), alist), NULL); |
ohneta | 0:e9a7a38d9ad3 | 307 | |
ohneta | 0:e9a7a38d9ad3 | 308 | case FCONS: |
ohneta | 0:e9a7a38d9ad3 | 309 | return cons(eval(car(cdr(x)),alist), eval(cdr(cdr(x)), alist)); |
ohneta | 0:e9a7a38d9ad3 | 310 | |
ohneta | 0:e9a7a38d9ad3 | 311 | case FLIST: |
ohneta | 0:e9a7a38d9ad3 | 312 | return _list(x); |
ohneta | 0:e9a7a38d9ad3 | 313 | |
ohneta | 0:e9a7a38d9ad3 | 314 | case COND: |
ohneta | 0:e9a7a38d9ad3 | 315 | return evalcond(cdr(x), alist); |
ohneta | 0:e9a7a38d9ad3 | 316 | |
ohneta | 0:e9a7a38d9ad3 | 317 | case FSETQ: |
ohneta | 0:e9a7a38d9ad3 | 318 | p = eval(cdr(cdr(x)), alist); |
ohneta | 0:e9a7a38d9ad3 | 319 | rplacd(getvar(alist, getname(car(car(cdr(x))))), p); |
ohneta | 0:e9a7a38d9ad3 | 320 | return p; |
ohneta | 0:e9a7a38d9ad3 | 321 | |
ohneta | 0:e9a7a38d9ad3 | 322 | case DEFUN: |
ohneta | 0:e9a7a38d9ad3 | 323 | rplact(car(car(cdr(x))), FUSER); |
ohneta | 0:e9a7a38d9ad3 | 324 | rplacd(car(car(cdr(x))), cdr(cdr(x))); |
ohneta | 0:e9a7a38d9ad3 | 325 | var_to_user(cdr(cdr(cdr(x)))); |
ohneta | 0:e9a7a38d9ad3 | 326 | if (fd == FILE_SERIAL) { |
ohneta | 0:e9a7a38d9ad3 | 327 | pc.printf("%s\n", getname(car(car(cdr(x))))); |
ohneta | 0:e9a7a38d9ad3 | 328 | } |
ohneta | 0:e9a7a38d9ad3 | 329 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 330 | |
ohneta | 0:e9a7a38d9ad3 | 331 | case FUSER: |
ohneta | 0:e9a7a38d9ad3 | 332 | p = cdr(car(car(x))); // p is statement list |
ohneta | 0:e9a7a38d9ad3 | 333 | return eval(car(cdr(p)), pairargs(car(p), evalargs(cdr(x),alist), alist, FALSE)); |
ohneta | 0:e9a7a38d9ad3 | 334 | |
ohneta | 0:e9a7a38d9ad3 | 335 | case FAPPLY: |
ohneta | 0:e9a7a38d9ad3 | 336 | case FUNCALL: |
ohneta | 0:e9a7a38d9ad3 | 337 | p = eval(car(cdr(x)), alist); // func name |
ohneta | 0:e9a7a38d9ad3 | 338 | if (isfunc(savt = type(car(p)))) { |
ohneta | 0:e9a7a38d9ad3 | 339 | p = cons(p, cdr(cdr(x))); |
ohneta | 0:e9a7a38d9ad3 | 340 | if (savt == FUSER) { |
ohneta | 0:e9a7a38d9ad3 | 341 | rplact(car(p), FUSER); |
ohneta | 0:e9a7a38d9ad3 | 342 | } |
ohneta | 0:e9a7a38d9ad3 | 343 | q = eval(p, alist); |
ohneta | 0:e9a7a38d9ad3 | 344 | rplact(car(p), savt); |
ohneta | 0:e9a7a38d9ad3 | 345 | return q; |
ohneta | 0:e9a7a38d9ad3 | 346 | } else |
ohneta | 0:e9a7a38d9ad3 | 347 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 348 | |
ohneta | 0:e9a7a38d9ad3 | 349 | case FEVAL: |
ohneta | 0:e9a7a38d9ad3 | 350 | p = eval(cdr(x), alist); |
ohneta | 0:e9a7a38d9ad3 | 351 | if (type(p) == SATOM) { |
ohneta | 0:e9a7a38d9ad3 | 352 | return assoc(alist, getname(car(p))); |
ohneta | 0:e9a7a38d9ad3 | 353 | } |
ohneta | 0:e9a7a38d9ad3 | 354 | return eval(p, alist); |
ohneta | 0:e9a7a38d9ad3 | 355 | |
ohneta | 0:e9a7a38d9ad3 | 356 | case PRINT: |
ohneta | 0:e9a7a38d9ad3 | 357 | lisp_print(eval(car(cdr(x)), alist)); |
ohneta | 0:e9a7a38d9ad3 | 358 | pc.printf("\n"); |
ohneta | 0:e9a7a38d9ad3 | 359 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 360 | |
ohneta | 0:e9a7a38d9ad3 | 361 | case FREAD: |
ohneta | 0:e9a7a38d9ad3 | 362 | return makelist(); |
ohneta | 0:e9a7a38d9ad3 | 363 | |
ohneta | 0:e9a7a38d9ad3 | 364 | case FAND: |
ohneta | 0:e9a7a38d9ad3 | 365 | return _and(x); |
ohneta | 0:e9a7a38d9ad3 | 366 | case FOR: |
ohneta | 0:e9a7a38d9ad3 | 367 | return _or(x); |
ohneta | 0:e9a7a38d9ad3 | 368 | case FNOT: |
ohneta | 0:e9a7a38d9ad3 | 369 | return _not(x); |
ohneta | 0:e9a7a38d9ad3 | 370 | |
ohneta | 0:e9a7a38d9ad3 | 371 | case PLUS: |
ohneta | 0:e9a7a38d9ad3 | 372 | case DIFF: |
ohneta | 0:e9a7a38d9ad3 | 373 | case TIMES: |
ohneta | 0:e9a7a38d9ad3 | 374 | case QUOTIENT: |
ohneta | 0:e9a7a38d9ad3 | 375 | case GREATERP: |
ohneta | 0:e9a7a38d9ad3 | 376 | case LESSP: |
ohneta | 0:e9a7a38d9ad3 | 377 | return arith(car(x), eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist)); |
ohneta | 0:e9a7a38d9ad3 | 378 | |
ohneta | 0:e9a7a38d9ad3 | 379 | case ADD1: |
ohneta | 0:e9a7a38d9ad3 | 380 | case SUB1: |
ohneta | 0:e9a7a38d9ad3 | 381 | return arith(car(x), eval(car(cdr(x)), alist), NULL); |
ohneta | 0:e9a7a38d9ad3 | 382 | |
ohneta | 0:e9a7a38d9ad3 | 383 | case ZEROP: |
ohneta | 0:e9a7a38d9ad3 | 384 | p = eval(car(cdr(x)), alist); |
ohneta | 0:e9a7a38d9ad3 | 385 | return (p->u.num == 0) ? TRU : NULL; |
ohneta | 0:e9a7a38d9ad3 | 386 | |
ohneta | 0:e9a7a38d9ad3 | 387 | case NUMBERP: |
ohneta | 0:e9a7a38d9ad3 | 388 | savt = type(eval(car(cdr(x)), alist)); |
ohneta | 0:e9a7a38d9ad3 | 389 | return (savt==IATOM || savt==RATOM) ? TRU : NULL; |
ohneta | 0:e9a7a38d9ad3 | 390 | |
ohneta | 0:e9a7a38d9ad3 | 391 | case PROG: |
ohneta | 0:e9a7a38d9ad3 | 392 | return evalprog(x, alist); |
ohneta | 0:e9a7a38d9ad3 | 393 | |
ohneta | 0:e9a7a38d9ad3 | 394 | case GO: |
ohneta | 0:e9a7a38d9ad3 | 395 | return cdr(car(car(cdr(x)))); |
ohneta | 0:e9a7a38d9ad3 | 396 | |
ohneta | 0:e9a7a38d9ad3 | 397 | case RETRN: |
ohneta | 0:e9a7a38d9ad3 | 398 | progon = FALSE; |
ohneta | 0:e9a7a38d9ad3 | 399 | return eval(cdr(x), alist); |
ohneta | 0:e9a7a38d9ad3 | 400 | |
ohneta | 0:e9a7a38d9ad3 | 401 | case LST: |
ohneta | 0:e9a7a38d9ad3 | 402 | if (cdr(x) == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 403 | return eval(car(x), alist); |
ohneta | 0:e9a7a38d9ad3 | 404 | } |
ohneta | 0:e9a7a38d9ad3 | 405 | return cons(eval(car(x),alist),eval(cdr(x),alist)); |
ohneta | 0:e9a7a38d9ad3 | 406 | |
ohneta | 0:e9a7a38d9ad3 | 407 | case VARI: |
ohneta | 0:e9a7a38d9ad3 | 408 | return assoc(alist, getname(car(car(x)))); |
ohneta | 0:e9a7a38d9ad3 | 409 | |
ohneta | 0:e9a7a38d9ad3 | 410 | case IATOM: |
ohneta | 0:e9a7a38d9ad3 | 411 | case RATOM: |
ohneta | 0:e9a7a38d9ad3 | 412 | return car(x); |
ohneta | 0:e9a7a38d9ad3 | 413 | |
ohneta | 0:e9a7a38d9ad3 | 414 | |
ohneta | 0:e9a7a38d9ad3 | 415 | |
ohneta | 0:e9a7a38d9ad3 | 416 | // mbed expand |
ohneta | 0:e9a7a38d9ad3 | 417 | case FINFO: |
ohneta | 0:e9a7a38d9ad3 | 418 | { |
ohneta | 0:e9a7a38d9ad3 | 419 | pc.printf("\noblist --\n"); |
ohneta | 0:e9a7a38d9ad3 | 420 | debug(g_oblist); |
ohneta | 0:e9a7a38d9ad3 | 421 | |
ohneta | 0:e9a7a38d9ad3 | 422 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 423 | } |
ohneta | 0:e9a7a38d9ad3 | 424 | case FFREEMEM: |
ohneta | 0:e9a7a38d9ad3 | 425 | { |
ohneta | 0:e9a7a38d9ad3 | 426 | LIST * p = memfreesize(); |
ohneta | 0:e9a7a38d9ad3 | 427 | if (p != NULL) { |
ohneta | 0:e9a7a38d9ad3 | 428 | p->gcbit = GARBAGE; |
ohneta | 0:e9a7a38d9ad3 | 429 | } |
ohneta | 0:e9a7a38d9ad3 | 430 | return p; |
ohneta | 0:e9a7a38d9ad3 | 431 | } |
ohneta | 0:e9a7a38d9ad3 | 432 | case FWAIT: |
ohneta | 0:e9a7a38d9ad3 | 433 | { |
ohneta | 0:e9a7a38d9ad3 | 434 | LIST * p = mbed_wait(eval(car(cdr(x)), alist)); |
ohneta | 1:a2955606adef | 435 | /* |
ohneta | 0:e9a7a38d9ad3 | 436 | if (p != NULL) { |
ohneta | 0:e9a7a38d9ad3 | 437 | p->gcbit = GARBAGE; |
ohneta | 0:e9a7a38d9ad3 | 438 | } |
ohneta | 1:a2955606adef | 439 | */ |
ohneta | 0:e9a7a38d9ad3 | 440 | return p; |
ohneta | 0:e9a7a38d9ad3 | 441 | } |
ohneta | 0:e9a7a38d9ad3 | 442 | case FDOUT: |
ohneta | 0:e9a7a38d9ad3 | 443 | return mbed_digitalout(eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist)); |
ohneta | 0:e9a7a38d9ad3 | 444 | case FDIN: |
ohneta | 0:e9a7a38d9ad3 | 445 | return mbed_digitalin(eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist)); |
ohneta | 0:e9a7a38d9ad3 | 446 | case FAOUT: |
ohneta | 0:e9a7a38d9ad3 | 447 | return mbed_analogout(eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist)); |
ohneta | 0:e9a7a38d9ad3 | 448 | case FAIN: |
ohneta | 0:e9a7a38d9ad3 | 449 | return mbed_analogin(eval(car(cdr(x)), alist)); |
ohneta | 0:e9a7a38d9ad3 | 450 | case PWMOUT: |
ohneta | 0:e9a7a38d9ad3 | 451 | return mbed_pwmout(eval(car(cdr(x)), alist), eval(car(cdr(cdr(x))), alist), eval(cdr(cdr(cdr(x))), alist)); |
ohneta | 0:e9a7a38d9ad3 | 452 | } |
ohneta | 0:e9a7a38d9ad3 | 453 | |
ohneta | 0:e9a7a38d9ad3 | 454 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 455 | } |
ohneta | 0:e9a7a38d9ad3 | 456 | |
ohneta | 0:e9a7a38d9ad3 | 457 | |
ohneta | 0:e9a7a38d9ad3 | 458 | LIST *evalcond(LIST *expr, LIST *alist) |
ohneta | 0:e9a7a38d9ad3 | 459 | { |
ohneta | 0:e9a7a38d9ad3 | 460 | if (expr == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 461 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 462 | } |
ohneta | 0:e9a7a38d9ad3 | 463 | |
ohneta | 0:e9a7a38d9ad3 | 464 | if (eval(car(car(expr)), alist) != NULL) { // expr was true |
ohneta | 0:e9a7a38d9ad3 | 465 | return eval(car(cdr(car(expr))), alist); // return result |
ohneta | 0:e9a7a38d9ad3 | 466 | } |
ohneta | 0:e9a7a38d9ad3 | 467 | |
ohneta | 0:e9a7a38d9ad3 | 468 | return evalcond(cdr(expr), alist); // eval rest of args |
ohneta | 0:e9a7a38d9ad3 | 469 | } |
ohneta | 0:e9a7a38d9ad3 | 470 | |
ohneta | 0:e9a7a38d9ad3 | 471 | |
ohneta | 0:e9a7a38d9ad3 | 472 | LIST *evalprog(LIST *p, LIST *alist) |
ohneta | 0:e9a7a38d9ad3 | 473 | { |
ohneta | 0:e9a7a38d9ad3 | 474 | LIST *x = NULL; |
ohneta | 0:e9a7a38d9ad3 | 475 | |
ohneta | 0:e9a7a38d9ad3 | 476 | // set up parameters as locals |
ohneta | 0:e9a7a38d9ad3 | 477 | alist = pairargs(car(cdr(p)), cons(NULL, NULL), alist, TRUE); |
ohneta | 0:e9a7a38d9ad3 | 478 | progon = TRUE; |
ohneta | 0:e9a7a38d9ad3 | 479 | p = cdr(cdr(p)); /* p now points to the statement list */ |
ohneta | 0:e9a7a38d9ad3 | 480 | find_labels(p); /* set up all labels in the prog */ |
ohneta | 0:e9a7a38d9ad3 | 481 | |
ohneta | 0:e9a7a38d9ad3 | 482 | while (p != NULL && progon) { |
ohneta | 0:e9a7a38d9ad3 | 483 | x = eval(car(p), alist); |
ohneta | 0:e9a7a38d9ad3 | 484 | if (type(car(car(p))) == GO) { |
ohneta | 0:e9a7a38d9ad3 | 485 | p = x; /* GO returned the next statement to go to */ |
ohneta | 0:e9a7a38d9ad3 | 486 | } else { |
ohneta | 0:e9a7a38d9ad3 | 487 | p = cdr(p); /* just follow regular chain of statements */ |
ohneta | 0:e9a7a38d9ad3 | 488 | |
ohneta | 0:e9a7a38d9ad3 | 489 | } |
ohneta | 0:e9a7a38d9ad3 | 490 | } |
ohneta | 0:e9a7a38d9ad3 | 491 | |
ohneta | 0:e9a7a38d9ad3 | 492 | progon = TRUE; /* in case of nested progs */ |
ohneta | 0:e9a7a38d9ad3 | 493 | return x; |
ohneta | 0:e9a7a38d9ad3 | 494 | } |
ohneta | 0:e9a7a38d9ad3 | 495 | |
ohneta | 0:e9a7a38d9ad3 | 496 | // pairargs - installs parameters in the alist, and sets the value to be the value of the corresponding argument. |
ohneta | 0:e9a7a38d9ad3 | 497 | LIST *pairargs(LIST *params, LIST *args, LIST *alist, int prog) |
ohneta | 0:e9a7a38d9ad3 | 498 | { |
ohneta | 0:e9a7a38d9ad3 | 499 | if (params == NULL) { // no more args to be evaluated |
ohneta | 0:e9a7a38d9ad3 | 500 | return alist; |
ohneta | 0:e9a7a38d9ad3 | 501 | } |
ohneta | 0:e9a7a38d9ad3 | 502 | |
ohneta | 0:e9a7a38d9ad3 | 503 | LIST *p = cons(NULL, car(args)); // value of param is corresponding arg |
ohneta | 0:e9a7a38d9ad3 | 504 | p->u.pname = getname(car(car(params))); |
ohneta | 0:e9a7a38d9ad3 | 505 | rplact(p, VARI); |
ohneta | 0:e9a7a38d9ad3 | 506 | if (prog) { |
ohneta | 0:e9a7a38d9ad3 | 507 | return cons(p, pairargs(cdr(params), cons(NULL,NULL), alist, prog)); |
ohneta | 0:e9a7a38d9ad3 | 508 | } |
ohneta | 0:e9a7a38d9ad3 | 509 | |
ohneta | 0:e9a7a38d9ad3 | 510 | return cons(p, pairargs(cdr(params), cdr(args), alist, prog)); |
ohneta | 0:e9a7a38d9ad3 | 511 | } |
ohneta | 0:e9a7a38d9ad3 | 512 | |
ohneta | 0:e9a7a38d9ad3 | 513 | LIST *evalargs(LIST *arglist, LIST *alist) |
ohneta | 0:e9a7a38d9ad3 | 514 | { |
ohneta | 0:e9a7a38d9ad3 | 515 | if (arglist == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 516 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 517 | } |
ohneta | 0:e9a7a38d9ad3 | 518 | |
ohneta | 0:e9a7a38d9ad3 | 519 | return cons(eval(car(arglist),alist), evalargs(cdr(arglist), alist)); |
ohneta | 0:e9a7a38d9ad3 | 520 | } |
ohneta | 0:e9a7a38d9ad3 | 521 | |
ohneta | 0:e9a7a38d9ad3 | 522 | LIST *assoc( LIST *alist, char *name) |
ohneta | 0:e9a7a38d9ad3 | 523 | { |
ohneta | 0:e9a7a38d9ad3 | 524 | return cdr(getvar(alist, name)); |
ohneta | 0:e9a7a38d9ad3 | 525 | } |
ohneta | 0:e9a7a38d9ad3 | 526 | |
ohneta | 0:e9a7a38d9ad3 | 527 | LIST *getvar(LIST *alist, char *name) |
ohneta | 0:e9a7a38d9ad3 | 528 | { |
ohneta | 0:e9a7a38d9ad3 | 529 | return lookup(alist, name); |
ohneta | 0:e9a7a38d9ad3 | 530 | } |
ohneta | 0:e9a7a38d9ad3 | 531 | |
ohneta | 0:e9a7a38d9ad3 | 532 | // arith - performs arithmetic on numeric items |
ohneta | 0:e9a7a38d9ad3 | 533 | LIST *arith(LIST *op, LIST *x, LIST *y) |
ohneta | 0:e9a7a38d9ad3 | 534 | { |
ohneta | 0:e9a7a38d9ad3 | 535 | LIST *p; |
ohneta | 0:e9a7a38d9ad3 | 536 | float res = 0; |
ohneta | 0:e9a7a38d9ad3 | 537 | int t = type(op); |
ohneta | 0:e9a7a38d9ad3 | 538 | |
ohneta | 0:e9a7a38d9ad3 | 539 | if (t == LESSP) { |
ohneta | 0:e9a7a38d9ad3 | 540 | return (x->u.num < y->u.num) ? TRU : NULL; |
ohneta | 0:e9a7a38d9ad3 | 541 | } |
ohneta | 0:e9a7a38d9ad3 | 542 | if (t == GREATERP) { |
ohneta | 0:e9a7a38d9ad3 | 543 | return (x->u.num > y->u.num) ? TRU : NULL; |
ohneta | 0:e9a7a38d9ad3 | 544 | } |
ohneta | 0:e9a7a38d9ad3 | 545 | |
ohneta | 0:e9a7a38d9ad3 | 546 | switch (t) { |
ohneta | 0:e9a7a38d9ad3 | 547 | case PLUS: |
ohneta | 0:e9a7a38d9ad3 | 548 | res = x->u.num + y->u.num; |
ohneta | 0:e9a7a38d9ad3 | 549 | break; |
ohneta | 0:e9a7a38d9ad3 | 550 | case DIFF: |
ohneta | 0:e9a7a38d9ad3 | 551 | res = x->u.num - y->u.num; |
ohneta | 0:e9a7a38d9ad3 | 552 | break; |
ohneta | 0:e9a7a38d9ad3 | 553 | case TIMES: |
ohneta | 0:e9a7a38d9ad3 | 554 | res = x->u.num * y->u.num; |
ohneta | 0:e9a7a38d9ad3 | 555 | break; |
ohneta | 0:e9a7a38d9ad3 | 556 | case QUOTIENT: |
ohneta | 0:e9a7a38d9ad3 | 557 | res = x->u.num / y->u.num; |
ohneta | 0:e9a7a38d9ad3 | 558 | break; |
ohneta | 0:e9a7a38d9ad3 | 559 | case ADD1: |
ohneta | 0:e9a7a38d9ad3 | 560 | res = x->u.num + 1; |
ohneta | 0:e9a7a38d9ad3 | 561 | break; |
ohneta | 0:e9a7a38d9ad3 | 562 | case SUB1: |
ohneta | 0:e9a7a38d9ad3 | 563 | res = x->u.num - 1; |
ohneta | 0:e9a7a38d9ad3 | 564 | break; |
ohneta | 0:e9a7a38d9ad3 | 565 | } |
ohneta | 0:e9a7a38d9ad3 | 566 | |
ohneta | 0:e9a7a38d9ad3 | 567 | p = cons(NULL, NULL); |
ohneta | 0:e9a7a38d9ad3 | 568 | |
ohneta | 0:e9a7a38d9ad3 | 569 | // @TODO: tがADD1かSUB1の場合、yは必ずNULLなので、 type(y)を実行するとエラーだと思うんだが... |
ohneta | 0:e9a7a38d9ad3 | 570 | /* |
ohneta | 0:e9a7a38d9ad3 | 571 | if ( (type(x) == IATOM) && |
ohneta | 0:e9a7a38d9ad3 | 572 | (type(y) == IATOM) || |
ohneta | 0:e9a7a38d9ad3 | 573 | (t == ADD1) || (t == SUB1) ) |
ohneta | 0:e9a7a38d9ad3 | 574 | ) { |
ohneta | 0:e9a7a38d9ad3 | 575 | */ |
ohneta | 0:e9a7a38d9ad3 | 576 | if ((type(x) == IATOM) && ((t == ADD1) || (t == SUB1))) { |
ohneta | 0:e9a7a38d9ad3 | 577 | p->u.num = (int)res; |
ohneta | 0:e9a7a38d9ad3 | 578 | rplact(p, IATOM); |
ohneta | 0:e9a7a38d9ad3 | 579 | } else { |
ohneta | 0:e9a7a38d9ad3 | 580 | p->u.num = res; |
ohneta | 0:e9a7a38d9ad3 | 581 | rplact(p, RATOM); |
ohneta | 0:e9a7a38d9ad3 | 582 | } |
ohneta | 0:e9a7a38d9ad3 | 583 | |
ohneta | 0:e9a7a38d9ad3 | 584 | return p; |
ohneta | 0:e9a7a38d9ad3 | 585 | } |
ohneta | 0:e9a7a38d9ad3 | 586 | |
ohneta | 0:e9a7a38d9ad3 | 587 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 588 | // input functions |
ohneta | 0:e9a7a38d9ad3 | 589 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 590 | |
ohneta | 0:e9a7a38d9ad3 | 591 | // advance - skips white space in input file |
ohneta | 0:e9a7a38d9ad3 | 592 | int advance() |
ohneta | 0:e9a7a38d9ad3 | 593 | { |
ohneta | 0:e9a7a38d9ad3 | 594 | int c; |
ohneta | 0:e9a7a38d9ad3 | 595 | #if 0 |
ohneta | 0:e9a7a38d9ad3 | 596 | while (((c = getc_mine(fd)) != EOF) && (strchr(" \t\n", c) != NULL)); |
ohneta | 0:e9a7a38d9ad3 | 597 | #else |
ohneta | 0:e9a7a38d9ad3 | 598 | while (1) { |
ohneta | 0:e9a7a38d9ad3 | 599 | c = getc_mine(fd); |
ohneta | 0:e9a7a38d9ad3 | 600 | if (c == EOF) { |
ohneta | 0:e9a7a38d9ad3 | 601 | break; |
ohneta | 0:e9a7a38d9ad3 | 602 | } |
ohneta | 0:e9a7a38d9ad3 | 603 | if (strchr(" \t\n\r", c) == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 604 | break; |
ohneta | 0:e9a7a38d9ad3 | 605 | } |
ohneta | 0:e9a7a38d9ad3 | 606 | } |
ohneta | 0:e9a7a38d9ad3 | 607 | #endif |
ohneta | 0:e9a7a38d9ad3 | 608 | ungetc_mine(c, fd); |
ohneta | 0:e9a7a38d9ad3 | 609 | //pc.printf("%c", c); |
ohneta | 0:e9a7a38d9ad3 | 610 | |
ohneta | 0:e9a7a38d9ad3 | 611 | return c; |
ohneta | 0:e9a7a38d9ad3 | 612 | } |
ohneta | 0:e9a7a38d9ad3 | 613 | |
ohneta | 0:e9a7a38d9ad3 | 614 | LIST *lookup(LIST *head, char *name) |
ohneta | 0:e9a7a38d9ad3 | 615 | { |
ohneta | 0:e9a7a38d9ad3 | 616 | LIST *p; |
ohneta | 0:e9a7a38d9ad3 | 617 | |
ohneta | 0:e9a7a38d9ad3 | 618 | #if 0 |
ohneta | 0:e9a7a38d9ad3 | 619 | for (p = head; p != NULL && strcmp(name, getname(car(p))); p = cdr(p)) { |
ohneta | 0:e9a7a38d9ad3 | 620 | ; |
ohneta | 0:e9a7a38d9ad3 | 621 | } |
ohneta | 0:e9a7a38d9ad3 | 622 | #else |
ohneta | 0:e9a7a38d9ad3 | 623 | p = head; |
ohneta | 0:e9a7a38d9ad3 | 624 | while (p != NULL) { |
ohneta | 0:e9a7a38d9ad3 | 625 | if (strcmp(name, getname(car(p))) == 0) { |
ohneta | 0:e9a7a38d9ad3 | 626 | break; |
ohneta | 0:e9a7a38d9ad3 | 627 | } |
ohneta | 0:e9a7a38d9ad3 | 628 | p = cdr(p); |
ohneta | 0:e9a7a38d9ad3 | 629 | } |
ohneta | 0:e9a7a38d9ad3 | 630 | #endif |
ohneta | 0:e9a7a38d9ad3 | 631 | |
ohneta | 0:e9a7a38d9ad3 | 632 | return ((p == NULL) ? NULL : car(p)); |
ohneta | 0:e9a7a38d9ad3 | 633 | } |
ohneta | 0:e9a7a38d9ad3 | 634 | |
ohneta | 1:a2955606adef | 635 | /** |
ohneta | 1:a2955606adef | 636 | * nameをalistに加える |
ohneta | 1:a2955606adef | 637 | * |
ohneta | 1:a2955606adef | 638 | * @param char *name alistに加える名前 |
ohneta | 1:a2955606adef | 639 | * @param bool nameCopyFlag nameをコピーするか否か。 true=コピーする、1=コピーしない(nameがconstな文字列) |
ohneta | 1:a2955606adef | 640 | */ |
ohneta | 1:a2955606adef | 641 | LIST *install(char *name, bool nameCopyFlag = true) |
ohneta | 0:e9a7a38d9ad3 | 642 | { |
ohneta | 1:a2955606adef | 643 | LIST *p = cons(NULL, NULL); |
ohneta | 0:e9a7a38d9ad3 | 644 | |
ohneta | 1:a2955606adef | 645 | if (nameCopyFlag) { |
ohneta | 1:a2955606adef | 646 | p->u.pname = (char *)emalloc(strlen(name) + 1); |
ohneta | 1:a2955606adef | 647 | strcpy(p->u.pname, name); |
ohneta | 1:a2955606adef | 648 | } else { |
ohneta | 1:a2955606adef | 649 | p->u.pname = name; |
ohneta | 1:a2955606adef | 650 | } |
ohneta | 1:a2955606adef | 651 | |
ohneta | 0:e9a7a38d9ad3 | 652 | rplact(p, VARI); |
ohneta | 0:e9a7a38d9ad3 | 653 | g_alist = cons(p, g_alist); |
ohneta | 0:e9a7a38d9ad3 | 654 | |
ohneta | 0:e9a7a38d9ad3 | 655 | return p; |
ohneta | 0:e9a7a38d9ad3 | 656 | } |
ohneta | 0:e9a7a38d9ad3 | 657 | |
ohneta | 0:e9a7a38d9ad3 | 658 | LIST *getnum() |
ohneta | 0:e9a7a38d9ad3 | 659 | { |
ohneta | 0:e9a7a38d9ad3 | 660 | LIST *p; |
ohneta | 0:e9a7a38d9ad3 | 661 | float sum, n; |
ohneta | 0:e9a7a38d9ad3 | 662 | int c; |
ohneta | 0:e9a7a38d9ad3 | 663 | |
ohneta | 0:e9a7a38d9ad3 | 664 | sum = 0.0; |
ohneta | 0:e9a7a38d9ad3 | 665 | p = cons(NULL, NULL); |
ohneta | 0:e9a7a38d9ad3 | 666 | rplact(p, IATOM); |
ohneta | 0:e9a7a38d9ad3 | 667 | |
ohneta | 0:e9a7a38d9ad3 | 668 | while (isdigit(c = getc_mine(fd))) { |
ohneta | 0:e9a7a38d9ad3 | 669 | sum = sum * 10 + c - '0'; |
ohneta | 0:e9a7a38d9ad3 | 670 | } |
ohneta | 0:e9a7a38d9ad3 | 671 | |
ohneta | 0:e9a7a38d9ad3 | 672 | if (c == '.') { /* the number is real */ |
ohneta | 0:e9a7a38d9ad3 | 673 | n = 10; |
ohneta | 0:e9a7a38d9ad3 | 674 | rplact(p, RATOM); |
ohneta | 0:e9a7a38d9ad3 | 675 | //while (isdigit(c = getc(fd))) { |
ohneta | 0:e9a7a38d9ad3 | 676 | while (isdigit(c = getc_mine(fd))) { |
ohneta | 0:e9a7a38d9ad3 | 677 | sum += (c - '0')/n; |
ohneta | 0:e9a7a38d9ad3 | 678 | n *= 10; |
ohneta | 0:e9a7a38d9ad3 | 679 | } |
ohneta | 0:e9a7a38d9ad3 | 680 | } |
ohneta | 0:e9a7a38d9ad3 | 681 | |
ohneta | 0:e9a7a38d9ad3 | 682 | ungetc_mine(c, fd); |
ohneta | 0:e9a7a38d9ad3 | 683 | p->u.num = sum; |
ohneta | 0:e9a7a38d9ad3 | 684 | |
ohneta | 0:e9a7a38d9ad3 | 685 | return p; |
ohneta | 0:e9a7a38d9ad3 | 686 | } |
ohneta | 0:e9a7a38d9ad3 | 687 | |
ohneta | 0:e9a7a38d9ad3 | 688 | LIST *getid() |
ohneta | 0:e9a7a38d9ad3 | 689 | { |
ohneta | 0:e9a7a38d9ad3 | 690 | LIST *p; |
ohneta | 0:e9a7a38d9ad3 | 691 | |
ohneta | 1:a2955606adef | 692 | char inbuf[120]; // トークン 1つ分のバッファ |
ohneta | 0:e9a7a38d9ad3 | 693 | char *s = inbuf; |
ohneta | 0:e9a7a38d9ad3 | 694 | LIST *idptr; |
ohneta | 0:e9a7a38d9ad3 | 695 | |
ohneta | 1:a2955606adef | 696 | // トークンを取得する |
ohneta | 1:a2955606adef | 697 | { |
ohneta | 1:a2955606adef | 698 | int c = getc_mine(fd); |
ohneta | 1:a2955606adef | 699 | *s = c; |
ohneta | 1:a2955606adef | 700 | s++; |
ohneta | 1:a2955606adef | 701 | if (c != '\'') { |
ohneta | 1:a2955606adef | 702 | while(1) { |
ohneta | 1:a2955606adef | 703 | c = getc_mine(fd); |
ohneta | 1:a2955606adef | 704 | if (!isalnum(c)) { |
ohneta | 1:a2955606adef | 705 | ungetc_mine(c, fd); |
ohneta | 1:a2955606adef | 706 | break; |
ohneta | 1:a2955606adef | 707 | } |
ohneta | 1:a2955606adef | 708 | *s = c; |
ohneta | 1:a2955606adef | 709 | s++; |
ohneta | 0:e9a7a38d9ad3 | 710 | } |
ohneta | 0:e9a7a38d9ad3 | 711 | } |
ohneta | 1:a2955606adef | 712 | *s = '\0'; |
ohneta | 0:e9a7a38d9ad3 | 713 | } |
ohneta | 0:e9a7a38d9ad3 | 714 | |
ohneta | 0:e9a7a38d9ad3 | 715 | if ((idptr = lookup(g_oblist, inbuf)) == NULL) { // not a LISP function |
ohneta | 0:e9a7a38d9ad3 | 716 | if ((idptr = lookup(g_alist, inbuf)) == NULL) { // id not declared yet |
ohneta | 1:a2955606adef | 717 | idptr = install(inbuf, true); // install it in g_alist (alist) |
ohneta | 0:e9a7a38d9ad3 | 718 | } |
ohneta | 0:e9a7a38d9ad3 | 719 | } |
ohneta | 0:e9a7a38d9ad3 | 720 | p = cons(idptr, NULL); |
ohneta | 0:e9a7a38d9ad3 | 721 | rplact(p, type(idptr)); |
ohneta | 0:e9a7a38d9ad3 | 722 | |
ohneta | 0:e9a7a38d9ad3 | 723 | return p; |
ohneta | 0:e9a7a38d9ad3 | 724 | } |
ohneta | 0:e9a7a38d9ad3 | 725 | |
ohneta | 0:e9a7a38d9ad3 | 726 | int gettok() |
ohneta | 0:e9a7a38d9ad3 | 727 | { |
ohneta | 0:e9a7a38d9ad3 | 728 | int c; |
ohneta | 0:e9a7a38d9ad3 | 729 | |
ohneta | 0:e9a7a38d9ad3 | 730 | while ((c = advance()) == ';') { // saw a comment |
ohneta | 0:e9a7a38d9ad3 | 731 | while (1) { |
ohneta | 0:e9a7a38d9ad3 | 732 | c = getc_mine(fd); |
ohneta | 0:e9a7a38d9ad3 | 733 | if ((c == EOF) || (c == '\n')) { // EOF or CR |
ohneta | 0:e9a7a38d9ad3 | 734 | break; |
ohneta | 0:e9a7a38d9ad3 | 735 | } |
ohneta | 0:e9a7a38d9ad3 | 736 | } |
ohneta | 0:e9a7a38d9ad3 | 737 | } |
ohneta | 0:e9a7a38d9ad3 | 738 | |
ohneta | 0:e9a7a38d9ad3 | 739 | if (isalpha(c)) { |
ohneta | 0:e9a7a38d9ad3 | 740 | return LETTER; |
ohneta | 0:e9a7a38d9ad3 | 741 | } |
ohneta | 0:e9a7a38d9ad3 | 742 | if (isdigit(c)) { |
ohneta | 0:e9a7a38d9ad3 | 743 | return DIGIT; |
ohneta | 0:e9a7a38d9ad3 | 744 | } |
ohneta | 0:e9a7a38d9ad3 | 745 | switch (c) { |
ohneta | 0:e9a7a38d9ad3 | 746 | case '(': |
ohneta | 0:e9a7a38d9ad3 | 747 | return LPAREN; |
ohneta | 0:e9a7a38d9ad3 | 748 | case ')': |
ohneta | 0:e9a7a38d9ad3 | 749 | return RPAREN; |
ohneta | 0:e9a7a38d9ad3 | 750 | case '\'': |
ohneta | 0:e9a7a38d9ad3 | 751 | return INQUOTE; |
ohneta | 0:e9a7a38d9ad3 | 752 | case EOF: |
ohneta | 0:e9a7a38d9ad3 | 753 | return EOF; |
ohneta | 0:e9a7a38d9ad3 | 754 | } |
ohneta | 0:e9a7a38d9ad3 | 755 | |
ohneta | 0:e9a7a38d9ad3 | 756 | return ERR; |
ohneta | 0:e9a7a38d9ad3 | 757 | } |
ohneta | 0:e9a7a38d9ad3 | 758 | |
ohneta | 0:e9a7a38d9ad3 | 759 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 760 | // LISP primitive functions |
ohneta | 0:e9a7a38d9ad3 | 761 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 762 | |
ohneta | 0:e9a7a38d9ad3 | 763 | // new - gets a new node from the free storage |
ohneta | 0:e9a7a38d9ad3 | 764 | LIST *new_malisp() |
ohneta | 0:e9a7a38d9ad3 | 765 | { |
ohneta | 0:e9a7a38d9ad3 | 766 | LIST *p = (struct LIST *)emalloc(sizeof(LIST)); |
ohneta | 0:e9a7a38d9ad3 | 767 | p->gcbit = RUNNING; |
ohneta | 0:e9a7a38d9ad3 | 768 | |
ohneta | 0:e9a7a38d9ad3 | 769 | return p; |
ohneta | 0:e9a7a38d9ad3 | 770 | } |
ohneta | 0:e9a7a38d9ad3 | 771 | |
ohneta | 0:e9a7a38d9ad3 | 772 | int type(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 773 | { |
ohneta | 0:e9a7a38d9ad3 | 774 | return p->htype; |
ohneta | 0:e9a7a38d9ad3 | 775 | } |
ohneta | 0:e9a7a38d9ad3 | 776 | |
ohneta | 0:e9a7a38d9ad3 | 777 | char* getname(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 778 | { |
ohneta | 0:e9a7a38d9ad3 | 779 | return (p == NULL) ? NULL : p->u.pname; |
ohneta | 0:e9a7a38d9ad3 | 780 | } |
ohneta | 0:e9a7a38d9ad3 | 781 | |
ohneta | 0:e9a7a38d9ad3 | 782 | // pのcar部をqに置き換える |
ohneta | 0:e9a7a38d9ad3 | 783 | void rplaca(LIST *p, LIST *q) |
ohneta | 0:e9a7a38d9ad3 | 784 | { |
ohneta | 0:e9a7a38d9ad3 | 785 | p->left = q; |
ohneta | 0:e9a7a38d9ad3 | 786 | } |
ohneta | 0:e9a7a38d9ad3 | 787 | |
ohneta | 0:e9a7a38d9ad3 | 788 | // pのcdr部をqに置き換える |
ohneta | 0:e9a7a38d9ad3 | 789 | void rplacd(LIST *p, LIST *q) |
ohneta | 0:e9a7a38d9ad3 | 790 | { |
ohneta | 0:e9a7a38d9ad3 | 791 | p->right = q; |
ohneta | 0:e9a7a38d9ad3 | 792 | } |
ohneta | 0:e9a7a38d9ad3 | 793 | |
ohneta | 0:e9a7a38d9ad3 | 794 | // pのタイプ(htype)をtに置き換える |
ohneta | 0:e9a7a38d9ad3 | 795 | void rplact(LIST *p, int t) |
ohneta | 0:e9a7a38d9ad3 | 796 | { |
ohneta | 0:e9a7a38d9ad3 | 797 | p->htype = t; |
ohneta | 0:e9a7a38d9ad3 | 798 | } |
ohneta | 0:e9a7a38d9ad3 | 799 | |
ohneta | 0:e9a7a38d9ad3 | 800 | LIST *car(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 801 | { |
ohneta | 0:e9a7a38d9ad3 | 802 | return (p == NULL) ? NULL : p->left; |
ohneta | 0:e9a7a38d9ad3 | 803 | } |
ohneta | 0:e9a7a38d9ad3 | 804 | |
ohneta | 0:e9a7a38d9ad3 | 805 | LIST *cdr(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 806 | { |
ohneta | 0:e9a7a38d9ad3 | 807 | return (p == NULL) ? NULL : p->right; |
ohneta | 0:e9a7a38d9ad3 | 808 | } |
ohneta | 0:e9a7a38d9ad3 | 809 | |
ohneta | 0:e9a7a38d9ad3 | 810 | LIST *cons(LIST *p, LIST *q) |
ohneta | 0:e9a7a38d9ad3 | 811 | { |
ohneta | 0:e9a7a38d9ad3 | 812 | LIST *x = new_malisp(); |
ohneta | 0:e9a7a38d9ad3 | 813 | |
ohneta | 0:e9a7a38d9ad3 | 814 | rplaca(x, p); |
ohneta | 0:e9a7a38d9ad3 | 815 | rplacd(x, q); |
ohneta | 0:e9a7a38d9ad3 | 816 | rplact(x, LST); |
ohneta | 0:e9a7a38d9ad3 | 817 | |
ohneta | 0:e9a7a38d9ad3 | 818 | return x; |
ohneta | 0:e9a7a38d9ad3 | 819 | } |
ohneta | 0:e9a7a38d9ad3 | 820 | |
ohneta | 0:e9a7a38d9ad3 | 821 | LIST *eq(LIST *x, LIST *y) |
ohneta | 0:e9a7a38d9ad3 | 822 | { |
ohneta | 0:e9a7a38d9ad3 | 823 | if (x == NULL || y == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 824 | if (x == y) { |
ohneta | 0:e9a7a38d9ad3 | 825 | return TRU; |
ohneta | 0:e9a7a38d9ad3 | 826 | } |
ohneta | 1:a2955606adef | 827 | } else if ( (type(x) == SATOM) && |
ohneta | 1:a2955606adef | 828 | (type(y) == SATOM) && |
ohneta | 1:a2955606adef | 829 | (car(x) == car(y)) ) { |
ohneta | 0:e9a7a38d9ad3 | 830 | return TRU; |
ohneta | 0:e9a7a38d9ad3 | 831 | } |
ohneta | 0:e9a7a38d9ad3 | 832 | |
ohneta | 0:e9a7a38d9ad3 | 833 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 834 | } |
ohneta | 0:e9a7a38d9ad3 | 835 | |
ohneta | 0:e9a7a38d9ad3 | 836 | LIST *atom(LIST *x) |
ohneta | 0:e9a7a38d9ad3 | 837 | { |
ohneta | 1:a2955606adef | 838 | #if 0 |
ohneta | 0:e9a7a38d9ad3 | 839 | int typ; |
ohneta | 0:e9a7a38d9ad3 | 840 | |
ohneta | 0:e9a7a38d9ad3 | 841 | if (x == NULL || (typ = type(x)) == IATOM || typ == RATOM || typ == SATOM) { |
ohneta | 0:e9a7a38d9ad3 | 842 | return TRU; |
ohneta | 0:e9a7a38d9ad3 | 843 | } |
ohneta | 1:a2955606adef | 844 | #else |
ohneta | 1:a2955606adef | 845 | if (x == NULL) { |
ohneta | 1:a2955606adef | 846 | return TRU; |
ohneta | 1:a2955606adef | 847 | } |
ohneta | 1:a2955606adef | 848 | |
ohneta | 1:a2955606adef | 849 | int typ = type(x); |
ohneta | 1:a2955606adef | 850 | if (typ == IATOM) { |
ohneta | 1:a2955606adef | 851 | return TRU; |
ohneta | 1:a2955606adef | 852 | } |
ohneta | 1:a2955606adef | 853 | if (typ == RATOM) { |
ohneta | 1:a2955606adef | 854 | return TRU; |
ohneta | 1:a2955606adef | 855 | } |
ohneta | 1:a2955606adef | 856 | if (typ == SATOM) { |
ohneta | 1:a2955606adef | 857 | return TRU; |
ohneta | 1:a2955606adef | 858 | } |
ohneta | 1:a2955606adef | 859 | #endif |
ohneta | 0:e9a7a38d9ad3 | 860 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 861 | } |
ohneta | 0:e9a7a38d9ad3 | 862 | |
ohneta | 0:e9a7a38d9ad3 | 863 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 864 | // logical connectives - and, or, not |
ohneta | 0:e9a7a38d9ad3 | 865 | |
ohneta | 0:e9a7a38d9ad3 | 866 | LIST *_and(LIST *x) |
ohneta | 0:e9a7a38d9ad3 | 867 | { |
ohneta | 0:e9a7a38d9ad3 | 868 | LIST *p; |
ohneta | 0:e9a7a38d9ad3 | 869 | for (p = cdr(x); p != NULL; p = cdr(p)) { |
ohneta | 0:e9a7a38d9ad3 | 870 | if (eval(car(p), NULL) == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 871 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 872 | } |
ohneta | 0:e9a7a38d9ad3 | 873 | } |
ohneta | 0:e9a7a38d9ad3 | 874 | |
ohneta | 0:e9a7a38d9ad3 | 875 | return TRU; |
ohneta | 0:e9a7a38d9ad3 | 876 | } |
ohneta | 0:e9a7a38d9ad3 | 877 | |
ohneta | 0:e9a7a38d9ad3 | 878 | LIST *_or(LIST *x) |
ohneta | 0:e9a7a38d9ad3 | 879 | { |
ohneta | 0:e9a7a38d9ad3 | 880 | LIST *p; |
ohneta | 0:e9a7a38d9ad3 | 881 | for (p = cdr(x); p != NULL; p = cdr(p)) { |
ohneta | 0:e9a7a38d9ad3 | 882 | if (eval(car(p), NULL) != NULL) { |
ohneta | 0:e9a7a38d9ad3 | 883 | return TRU; |
ohneta | 0:e9a7a38d9ad3 | 884 | } |
ohneta | 0:e9a7a38d9ad3 | 885 | } |
ohneta | 0:e9a7a38d9ad3 | 886 | |
ohneta | 0:e9a7a38d9ad3 | 887 | return NULL; |
ohneta | 0:e9a7a38d9ad3 | 888 | } |
ohneta | 0:e9a7a38d9ad3 | 889 | |
ohneta | 0:e9a7a38d9ad3 | 890 | LIST *_not(LIST *x) |
ohneta | 0:e9a7a38d9ad3 | 891 | { |
ohneta | 0:e9a7a38d9ad3 | 892 | return (eval(cdr(x), NULL) == NULL) ? TRU : NULL; |
ohneta | 0:e9a7a38d9ad3 | 893 | } |
ohneta | 0:e9a7a38d9ad3 | 894 | |
ohneta | 0:e9a7a38d9ad3 | 895 | // other primitives |
ohneta | 0:e9a7a38d9ad3 | 896 | |
ohneta | 0:e9a7a38d9ad3 | 897 | LIST *_list(LIST *x) |
ohneta | 0:e9a7a38d9ad3 | 898 | { |
ohneta | 0:e9a7a38d9ad3 | 899 | LIST *res, *p; |
ohneta | 0:e9a7a38d9ad3 | 900 | |
ohneta | 0:e9a7a38d9ad3 | 901 | for (res = NULL, p = cdr(x); p != NULL; p = cdr(p)) { |
ohneta | 0:e9a7a38d9ad3 | 902 | res = cons(res, car(p)); |
ohneta | 0:e9a7a38d9ad3 | 903 | } |
ohneta | 0:e9a7a38d9ad3 | 904 | |
ohneta | 0:e9a7a38d9ad3 | 905 | return res; |
ohneta | 0:e9a7a38d9ad3 | 906 | } |
ohneta | 0:e9a7a38d9ad3 | 907 | |
ohneta | 0:e9a7a38d9ad3 | 908 | |
ohneta | 0:e9a7a38d9ad3 | 909 | void var_to_user(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 910 | { |
ohneta | 0:e9a7a38d9ad3 | 911 | if (p == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 912 | return; |
ohneta | 0:e9a7a38d9ad3 | 913 | } |
ohneta | 0:e9a7a38d9ad3 | 914 | |
ohneta | 0:e9a7a38d9ad3 | 915 | if (type(p) == VARI) { |
ohneta | 0:e9a7a38d9ad3 | 916 | if (type(car(p)) == FUSER) { |
ohneta | 0:e9a7a38d9ad3 | 917 | rplact(p, FUSER); |
ohneta | 0:e9a7a38d9ad3 | 918 | } |
ohneta | 0:e9a7a38d9ad3 | 919 | } else if (type(p) == LST) { |
ohneta | 0:e9a7a38d9ad3 | 920 | var_to_user(car(p)); |
ohneta | 0:e9a7a38d9ad3 | 921 | var_to_user(cdr(p)); |
ohneta | 0:e9a7a38d9ad3 | 922 | } |
ohneta | 0:e9a7a38d9ad3 | 923 | } |
ohneta | 0:e9a7a38d9ad3 | 924 | |
ohneta | 0:e9a7a38d9ad3 | 925 | void var_to_atom(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 926 | { |
ohneta | 0:e9a7a38d9ad3 | 927 | int t; |
ohneta | 0:e9a7a38d9ad3 | 928 | |
ohneta | 0:e9a7a38d9ad3 | 929 | if (p != NULL) { |
ohneta | 0:e9a7a38d9ad3 | 930 | if (((t = type(p)) != LST && !isfunc(t)) || t == FUSER) { |
ohneta | 0:e9a7a38d9ad3 | 931 | rplact(p, SATOM); |
ohneta | 0:e9a7a38d9ad3 | 932 | } else { |
ohneta | 0:e9a7a38d9ad3 | 933 | var_to_atom(car(p)); var_to_atom(cdr(p)); |
ohneta | 0:e9a7a38d9ad3 | 934 | } |
ohneta | 0:e9a7a38d9ad3 | 935 | } |
ohneta | 0:e9a7a38d9ad3 | 936 | } |
ohneta | 0:e9a7a38d9ad3 | 937 | |
ohneta | 0:e9a7a38d9ad3 | 938 | // find_labels - change the type of all labels in a PROG to LABL |
ohneta | 0:e9a7a38d9ad3 | 939 | void find_labels(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 940 | { |
ohneta | 0:e9a7a38d9ad3 | 941 | for ( ; p != NULL; p = cdr(p)) { |
ohneta | 0:e9a7a38d9ad3 | 942 | if (type(car(p)) == VARI) { |
ohneta | 0:e9a7a38d9ad3 | 943 | rplact(car(p), LABL); // change the type to LABL |
ohneta | 0:e9a7a38d9ad3 | 944 | rplacd(car(car(p)), cdr(p)); // label points to next statement |
ohneta | 0:e9a7a38d9ad3 | 945 | } |
ohneta | 0:e9a7a38d9ad3 | 946 | } |
ohneta | 0:e9a7a38d9ad3 | 947 | } |
ohneta | 0:e9a7a38d9ad3 | 948 | |
ohneta | 0:e9a7a38d9ad3 | 949 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 950 | // garbage collection |
ohneta | 0:e9a7a38d9ad3 | 951 | //---------------------------------------------------------------- |
ohneta | 0:e9a7a38d9ad3 | 952 | |
ohneta | 0:e9a7a38d9ad3 | 953 | void work_garbageCollect(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 954 | { |
ohneta | 0:e9a7a38d9ad3 | 955 | int cnt = 0; |
ohneta | 0:e9a7a38d9ad3 | 956 | while (p != NULL) { |
ohneta | 0:e9a7a38d9ad3 | 957 | |
ohneta | 0:e9a7a38d9ad3 | 958 | int t = type(p); |
ohneta | 0:e9a7a38d9ad3 | 959 | |
ohneta | 0:e9a7a38d9ad3 | 960 | pc.printf("[%d] ", cnt); |
ohneta | 0:e9a7a38d9ad3 | 961 | pc.printf("(%d) ", t); |
ohneta | 0:e9a7a38d9ad3 | 962 | if ((t == IATOM) || (t == RATOM)) { |
ohneta | 0:e9a7a38d9ad3 | 963 | pc.printf("[%f ] : ", p->u.num); |
ohneta | 0:e9a7a38d9ad3 | 964 | } else if (t == SATOM) { |
ohneta | 0:e9a7a38d9ad3 | 965 | pc.printf("[%s ] : ", p->u.pname); |
ohneta | 0:e9a7a38d9ad3 | 966 | } else { |
ohneta | 0:e9a7a38d9ad3 | 967 | pc.printf(" : "); |
ohneta | 0:e9a7a38d9ad3 | 968 | } |
ohneta | 0:e9a7a38d9ad3 | 969 | |
ohneta | 1:a2955606adef | 970 | //pc.printf("%d : ", (p->gcbit >> 16) & 0xff); // num |
ohneta | 1:a2955606adef | 971 | //pc.printf("%d \n", (p->gcbit & 0xff)); // bit (USED/RUNNING) |
ohneta | 0:e9a7a38d9ad3 | 972 | |
ohneta | 0:e9a7a38d9ad3 | 973 | p = cdr(p); |
ohneta | 0:e9a7a38d9ad3 | 974 | cnt++; |
ohneta | 0:e9a7a38d9ad3 | 975 | } |
ohneta | 0:e9a7a38d9ad3 | 976 | } |
ohneta | 0:e9a7a38d9ad3 | 977 | |
ohneta | 0:e9a7a38d9ad3 | 978 | // marktree - recursively marks all used items in a list |
ohneta | 0:e9a7a38d9ad3 | 979 | void marktree(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 980 | { |
ohneta | 0:e9a7a38d9ad3 | 981 | if (p != NULL) { |
ohneta | 0:e9a7a38d9ad3 | 982 | if (type(p) == LST) { |
ohneta | 0:e9a7a38d9ad3 | 983 | marktree(car(p)); |
ohneta | 0:e9a7a38d9ad3 | 984 | marktree(cdr(p)); |
ohneta | 0:e9a7a38d9ad3 | 985 | } |
ohneta | 0:e9a7a38d9ad3 | 986 | p->gcbit = USED; |
ohneta | 0:e9a7a38d9ad3 | 987 | } |
ohneta | 0:e9a7a38d9ad3 | 988 | } |
ohneta | 0:e9a7a38d9ad3 | 989 | |
ohneta | 0:e9a7a38d9ad3 | 990 | /*********************** storage allocator *****************/ |
ohneta | 0:e9a7a38d9ad3 | 991 | |
ohneta | 0:e9a7a38d9ad3 | 992 | void *emalloc(size_t size) |
ohneta | 0:e9a7a38d9ad3 | 993 | { |
ohneta | 0:e9a7a38d9ad3 | 994 | void *s; |
ohneta | 0:e9a7a38d9ad3 | 995 | |
ohneta | 0:e9a7a38d9ad3 | 996 | if ((s = malloc(size)) == NULL) { |
ohneta | 0:e9a7a38d9ad3 | 997 | pc.printf("OUT OF MEMORY !! : crashed !! \n"); |
ohneta | 0:e9a7a38d9ad3 | 998 | exit(0); |
ohneta | 0:e9a7a38d9ad3 | 999 | } |
ohneta | 0:e9a7a38d9ad3 | 1000 | |
ohneta | 0:e9a7a38d9ad3 | 1001 | return s; |
ohneta | 0:e9a7a38d9ad3 | 1002 | } |
ohneta | 0:e9a7a38d9ad3 | 1003 | |
ohneta | 0:e9a7a38d9ad3 | 1004 | // routine to load the library of lisp functions in |
ohneta | 0:e9a7a38d9ad3 | 1005 | void load_library(void) |
ohneta | 0:e9a7a38d9ad3 | 1006 | { |
ohneta | 0:e9a7a38d9ad3 | 1007 | #if 0 |
ohneta | 0:e9a7a38d9ad3 | 1008 | char libpath[1024]; |
ohneta | 0:e9a7a38d9ad3 | 1009 | strcpy(libpath, getenv("HOME")); |
ohneta | 0:e9a7a38d9ad3 | 1010 | strcat(libpath, "/lisplib"); |
ohneta | 0:e9a7a38d9ad3 | 1011 | |
ohneta | 0:e9a7a38d9ad3 | 1012 | if ((fd = fopen(libpath, "r")) != NULL) { |
ohneta | 0:e9a7a38d9ad3 | 1013 | interpret_malisp(); |
ohneta | 0:e9a7a38d9ad3 | 1014 | fclose(fd); |
ohneta | 0:e9a7a38d9ad3 | 1015 | |
ohneta | 0:e9a7a38d9ad3 | 1016 | pc.printf("loaded lisplib from %s\n", libpath); |
ohneta | 0:e9a7a38d9ad3 | 1017 | } |
ohneta | 0:e9a7a38d9ad3 | 1018 | interpret_malisp(); |
ohneta | 0:e9a7a38d9ad3 | 1019 | |
ohneta | 0:e9a7a38d9ad3 | 1020 | fd = stdin; |
ohneta | 0:e9a7a38d9ad3 | 1021 | #else |
ohneta | 0:e9a7a38d9ad3 | 1022 | |
ohneta | 0:e9a7a38d9ad3 | 1023 | fd = FILE_STRING; |
ohneta | 0:e9a7a38d9ad3 | 1024 | interpret_malisp(); |
ohneta | 0:e9a7a38d9ad3 | 1025 | pc.printf("loaded lisplib from flash\n"); |
ohneta | 0:e9a7a38d9ad3 | 1026 | |
ohneta | 0:e9a7a38d9ad3 | 1027 | fd = FILE_SERIAL; |
ohneta | 0:e9a7a38d9ad3 | 1028 | |
ohneta | 0:e9a7a38d9ad3 | 1029 | #endif |
ohneta | 0:e9a7a38d9ad3 | 1030 | } |
ohneta | 0:e9a7a38d9ad3 | 1031 | |
ohneta | 0:e9a7a38d9ad3 | 1032 | // isfunc - returns YES if type t is a user-function or a lisp primitive |
ohneta | 0:e9a7a38d9ad3 | 1033 | int isfunc(int t) |
ohneta | 0:e9a7a38d9ad3 | 1034 | { |
ohneta | 0:e9a7a38d9ad3 | 1035 | return |
ohneta | 0:e9a7a38d9ad3 | 1036 | ( t==FUSER || t==ADD1 || t==SUB1 || t==PLUS || t==DIFF || t==TIMES || |
ohneta | 0:e9a7a38d9ad3 | 1037 | t==QUOTIENT || t==LESSP || t==GREATERP || t==ZEROP || t==NUMBERP || |
ohneta | 0:e9a7a38d9ad3 | 1038 | t==FCAR || t==FCDR || t==FCONS || t==FREAD || t==PRINT || t==FNOT|| |
ohneta | 0:e9a7a38d9ad3 | 1039 | t==FAND || t==FOR || t==FEVAL || t==FEQ || t==FATOM || |
ohneta | 0:e9a7a38d9ad3 | 1040 | |
ohneta | 0:e9a7a38d9ad3 | 1041 | // mbed extends |
ohneta | 0:e9a7a38d9ad3 | 1042 | t == FFREEMEM || t == FWAIT || t == FDOUT || t == FDIN || |
ohneta | 0:e9a7a38d9ad3 | 1043 | t == FAOUT || t == FAIN || t == PWMOUT |
ohneta | 0:e9a7a38d9ad3 | 1044 | ); |
ohneta | 0:e9a7a38d9ad3 | 1045 | } |
ohneta | 0:e9a7a38d9ad3 | 1046 | |
ohneta | 0:e9a7a38d9ad3 | 1047 | void debug(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 1048 | { |
ohneta | 0:e9a7a38d9ad3 | 1049 | pc.printf("DEBUG ---\n"); |
ohneta | 0:e9a7a38d9ad3 | 1050 | debug2(p); |
ohneta | 0:e9a7a38d9ad3 | 1051 | pc.printf("\n"); |
ohneta | 0:e9a7a38d9ad3 | 1052 | } |
ohneta | 0:e9a7a38d9ad3 | 1053 | |
ohneta | 0:e9a7a38d9ad3 | 1054 | void debug2(LIST *p) |
ohneta | 0:e9a7a38d9ad3 | 1055 | { |
ohneta | 0:e9a7a38d9ad3 | 1056 | int t; |
ohneta | 0:e9a7a38d9ad3 | 1057 | |
ohneta | 0:e9a7a38d9ad3 | 1058 | if (p != NULL) { |
ohneta | 0:e9a7a38d9ad3 | 1059 | if ((t = type(p)) == LST) { |
ohneta | 0:e9a7a38d9ad3 | 1060 | pc.printf("("); |
ohneta | 0:e9a7a38d9ad3 | 1061 | debug2(car(p)); |
ohneta | 0:e9a7a38d9ad3 | 1062 | debug2(cdr(p)); |
ohneta | 0:e9a7a38d9ad3 | 1063 | pc.printf(")"); |
ohneta | 0:e9a7a38d9ad3 | 1064 | } else if (t == RATOM) { |
ohneta | 0:e9a7a38d9ad3 | 1065 | pc.printf("RATOM %f ", p->u.num); |
ohneta | 0:e9a7a38d9ad3 | 1066 | } else if (t == IATOM) { |
ohneta | 0:e9a7a38d9ad3 | 1067 | pc.printf("IATOM %d ", (int) p->u.num); |
ohneta | 0:e9a7a38d9ad3 | 1068 | } else if (t == SATOM) { |
ohneta | 0:e9a7a38d9ad3 | 1069 | pc.printf("SATOM %s ", getname(car(p))); |
ohneta | 0:e9a7a38d9ad3 | 1070 | } else { |
ohneta | 0:e9a7a38d9ad3 | 1071 | pc.printf("FUNC %d ", type(p)); |
ohneta | 0:e9a7a38d9ad3 | 1072 | } |
ohneta | 0:e9a7a38d9ad3 | 1073 | } |
ohneta | 0:e9a7a38d9ad3 | 1074 | } |