Jared DiCarlo / Mbed 2 deprecated manworm_tv_gpu

asdf

Dependencies:   mbed

Fork of manworm_ticker_tv by Bayley Wang

lisp.cpp@9:2a47b9ff8911, 2018-03-10 (annotated)

Committer:
dicarloj
Date:
Sat Mar 10 05:09:55 2018 +0000
Revision:
9:2a47b9ff8911
Child:
10:1163fb31b0a7
before buffer switch

Who changed what in which revision?

UserRevisionLine numberNew contents of line
dicarloj 9:2a47b9ff8911 1 ///* A minimal Lisp interpreter
dicarloj 9:2a47b9ff8911 2 // Copyright 2004 Andru Luvisi
dicarloj 9:2a47b9ff8911 3 //
dicarloj 9:2a47b9ff8911 4 // This program is free software; you can redistribute it and/or modify
dicarloj 9:2a47b9ff8911 5 // it under the terms of the GNU General Public License as published by
dicarloj 9:2a47b9ff8911 6 // the Free Software Foundation; either version 2 of the License , or
dicarloj 9:2a47b9ff8911 7 // (at your option) any later version.
dicarloj 9:2a47b9ff8911 8 //
dicarloj 9:2a47b9ff8911 9 // This program is distributed in the hope that it will be useful,
dicarloj 9:2a47b9ff8911 10 // but WITHOUT ANY WARRANTY; without even the implied warranty of
dicarloj 9:2a47b9ff8911 11 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
dicarloj 9:2a47b9ff8911 12 // GNU General Public License for more details.
dicarloj 9:2a47b9ff8911 13 //
dicarloj 9:2a47b9ff8911 14 // You should have received a copy of the GNU General Public License
dicarloj 9:2a47b9ff8911 15 // along with this program. If not, write to the Free Software
dicarloj 9:2a47b9ff8911 16 // Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
dicarloj 9:2a47b9ff8911 17 // */
dicarloj 9:2a47b9ff8911 18 //
dicarloj 9:2a47b9ff8911 19 //
dicarloj 9:2a47b9ff8911 20 //#include <stdio.h>
dicarloj 9:2a47b9ff8911 21 //#include <stdlib.h>
dicarloj 9:2a47b9ff8911 22 //#include <stdarg.h>
dicarloj 9:2a47b9ff8911 23 //#include <string.h>
dicarloj 9:2a47b9ff8911 24 //#include <ctype.h>
dicarloj 9:2a47b9ff8911 25 //#include "main.h"
dicarloj 9:2a47b9ff8911 26 //
dicarloj 9:2a47b9ff8911 27 //#define error(X) do { printf("ERROR: %s\n", X); } while (0)
dicarloj 9:2a47b9ff8911 28 //#define out_buf_size 5000
dicarloj 9:2a47b9ff8911 29 //#define in_buf_size 5000
dicarloj 9:2a47b9ff8911 30 //
dicarloj 9:2a47b9ff8911 31 //int out_counter = 0;
dicarloj 9:2a47b9ff8911 32 //int in_counter = 0;
dicarloj 9:2a47b9ff8911 33 //char out_buf[out_buf_size];
dicarloj 9:2a47b9ff8911 34 //char in_buf [in_buf_size];
dicarloj 9:2a47b9ff8911 35 //
dicarloj 9:2a47b9ff8911 36 //char lisp_exit = 0;
dicarloj 9:2a47b9ff8911 37 //
dicarloj 9:2a47b9ff8911 38 //void init_buf()
dicarloj 9:2a47b9ff8911 39 //{
dicarloj 9:2a47b9ff8911 40 // for(int i = 0; i < out_buf_size; i++)
dicarloj 9:2a47b9ff8911 41 // out_buf[i] = 0;
dicarloj 9:2a47b9ff8911 42 //
dicarloj 9:2a47b9ff8911 43 // for(int i = 0; i < in_buf_size; i++)
dicarloj 9:2a47b9ff8911 44 // in_buf[i] = 0;
dicarloj 9:2a47b9ff8911 45 //
dicarloj 9:2a47b9ff8911 46 // out_buf[out_buf_size - 1] = 0;
dicarloj 9:2a47b9ff8911 47 // out_counter = 0;
dicarloj 9:2a47b9ff8911 48 // in_counter = 0;
dicarloj 9:2a47b9ff8911 49 //}
dicarloj 9:2a47b9ff8911 50 //
dicarloj 9:2a47b9ff8911 51 //char getc_2()
dicarloj 9:2a47b9ff8911 52 //{
dicarloj 9:2a47b9ff8911 53 // //draw_vincent_string("getc2");
dicarloj 9:2a47b9ff8911 54 // in_counter++;
dicarloj 9:2a47b9ff8911 55 // if(in_counter >= in_buf_size)
dicarloj 9:2a47b9ff8911 56 // {
dicarloj 9:2a47b9ff8911 57 // lisp_exit = 1;
dicarloj 9:2a47b9ff8911 58 // return EOF;
dicarloj 9:2a47b9ff8911 59 // }
dicarloj 9:2a47b9ff8911 60 //
dicarloj 9:2a47b9ff8911 61 // char next_char = in_buf[in_counter - 1];
dicarloj 9:2a47b9ff8911 62 //
dicarloj 9:2a47b9ff8911 63 // if(next_char == 0)
dicarloj 9:2a47b9ff8911 64 // {
dicarloj 9:2a47b9ff8911 65 // lisp_exit = 1;
dicarloj 9:2a47b9ff8911 66 // return EOF;
dicarloj 9:2a47b9ff8911 67 // }
dicarloj 9:2a47b9ff8911 68 //
dicarloj 9:2a47b9ff8911 69 // return in_buf[in_counter-1];
dicarloj 9:2a47b9ff8911 70 //}
dicarloj 9:2a47b9ff8911 71 //
dicarloj 9:2a47b9ff8911 72 //void ungetc_2(char c)
dicarloj 9:2a47b9ff8911 73 //{
dicarloj 9:2a47b9ff8911 74 // in_counter--;
dicarloj 9:2a47b9ff8911 75 //}
dicarloj 9:2a47b9ff8911 76 //
dicarloj 9:2a47b9ff8911 77 //
dicarloj 9:2a47b9ff8911 78 //char* strdup_2(char* in)
dicarloj 9:2a47b9ff8911 79 //{
dicarloj 9:2a47b9ff8911 80 // char* new_string = (char*)malloc(strlen(in));
dicarloj 9:2a47b9ff8911 81 // strcpy(new_string,in);
dicarloj 9:2a47b9ff8911 82 // return new_string;
dicarloj 9:2a47b9ff8911 83 //}
dicarloj 9:2a47b9ff8911 84 //
dicarloj 9:2a47b9ff8911 85 //void write_out(char* str)
dicarloj 9:2a47b9ff8911 86 //{
dicarloj 9:2a47b9ff8911 87 // printf("write_out: %s\n",str);
dicarloj 9:2a47b9ff8911 88 //
dicarloj 9:2a47b9ff8911 89 // int len = strlen(str);
dicarloj 9:2a47b9ff8911 90 //
dicarloj 9:2a47b9ff8911 91 // if(len + out_counter < out_buf_size)
dicarloj 9:2a47b9ff8911 92 // {
dicarloj 9:2a47b9ff8911 93 // printf("BUUFER OVERLFOW!\n");
dicarloj 9:2a47b9ff8911 94 // return;
dicarloj 9:2a47b9ff8911 95 // }
dicarloj 9:2a47b9ff8911 96 //
dicarloj 9:2a47b9ff8911 97 // memcpy(out_buf + out_counter, str, len);
dicarloj 9:2a47b9ff8911 98 //}
dicarloj 9:2a47b9ff8911 99 //
dicarloj 9:2a47b9ff8911 100 //int line_num = 1;
dicarloj 9:2a47b9ff8911 101 //int total_malloc = 0;
dicarloj 9:2a47b9ff8911 102 //
dicarloj 9:2a47b9ff8911 103 ///*** List Structured Memory ***/
dicarloj 9:2a47b9ff8911 104 //enum otype { INT, SYM, CONS, PROC, PRIMOP };
dicarloj 9:2a47b9ff8911 105 //typedef struct obj {
dicarloj 9:2a47b9ff8911 106 // enum otype type;
dicarloj 9:2a47b9ff8911 107 // int line_num;
dicarloj 9:2a47b9ff8911 108 // struct obj *p[1];
dicarloj 9:2a47b9ff8911 109 //} obj;
dicarloj 9:2a47b9ff8911 110 //typedef obj * (*primop)(obj *);
dicarloj 9:2a47b9ff8911 111 //obj *all_symbols, *top_env, *nil, *tee, *quote,
dicarloj 9:2a47b9ff8911 112 // *s_if, *s_lambda, *s_define, *s_setb, *s_begin;
dicarloj 9:2a47b9ff8911 113 //
dicarloj 9:2a47b9ff8911 114 //#define cons(X, Y) omake(CONS, 2, (X), (Y))
dicarloj 9:2a47b9ff8911 115 //
dicarloj 9:2a47b9ff8911 116 //obj *car(obj *X) {
dicarloj 9:2a47b9ff8911 117 // if(X == 0) {
dicarloj 9:2a47b9ff8911 118 // sprintf(out_buf + strlen(out_buf),"warning: car argument null on line %d\n", line_num);
dicarloj 9:2a47b9ff8911 119 // return nil;
dicarloj 9:2a47b9ff8911 120 // }
dicarloj 9:2a47b9ff8911 121 // if(X == nil)
dicarloj 9:2a47b9ff8911 122 // return nil;
dicarloj 9:2a47b9ff8911 123 // if(X->type != CONS) {
dicarloj 9:2a47b9ff8911 124 // sprintf(out_buf + strlen(out_buf),"warning: car argument not a list (%d) on line %d\n", X->p[0], X->line_num);
dicarloj 9:2a47b9ff8911 125 // return nil;
dicarloj 9:2a47b9ff8911 126 // }
dicarloj 9:2a47b9ff8911 127 // return X->p[0];
dicarloj 9:2a47b9ff8911 128 //}
dicarloj 9:2a47b9ff8911 129 //
dicarloj 9:2a47b9ff8911 130 //obj *cdr(obj *X) {
dicarloj 9:2a47b9ff8911 131 // if(X == nil)
dicarloj 9:2a47b9ff8911 132 // return nil;
dicarloj 9:2a47b9ff8911 133 // if(X->type != CONS) {
dicarloj 9:2a47b9ff8911 134 // sprintf(out_buf + strlen(out_buf),"warning: cdr argument not a list on line %d\n", X->line_num);
dicarloj 9:2a47b9ff8911 135 // return nil;
dicarloj 9:2a47b9ff8911 136 // }
dicarloj 9:2a47b9ff8911 137 // if(X->p[1] == 0) {
dicarloj 9:2a47b9ff8911 138 // sprintf(out_buf + strlen(out_buf),"error: cdr list element is zero-pointer at %d\n", X->line_num);
dicarloj 9:2a47b9ff8911 139 // return nil;
dicarloj 9:2a47b9ff8911 140 // }
dicarloj 9:2a47b9ff8911 141 // return X->p[1];
dicarloj 9:2a47b9ff8911 142 //}
dicarloj 9:2a47b9ff8911 143 //
dicarloj 9:2a47b9ff8911 144 //#define setcar(X,Y) (((X)->p[0]) = (Y))
dicarloj 9:2a47b9ff8911 145 //#define setcdr(X,Y) (((X)->p[1]) = (Y))
dicarloj 9:2a47b9ff8911 146 //#define mkint(X) omake(INT, 1, (obj *)(X))
dicarloj 9:2a47b9ff8911 147 //#define intval(X) ((int)((X)->type == INT ? (X)->p[0] : 0)) // intval for INT only
dicarloj 9:2a47b9ff8911 148 //#define mksym(X) omake(SYM, 1, (obj *)(X))
dicarloj 9:2a47b9ff8911 149 //#define symname(X) ((char *)((X)->p[0]))
dicarloj 9:2a47b9ff8911 150 //#define mkprimop(X) omake(PRIMOP, 1, (obj *)(X))
dicarloj 9:2a47b9ff8911 151 //#define primopval(X) ((primop)(X)->p[0])
dicarloj 9:2a47b9ff8911 152 //#define mkproc(X,Y,Z) omake(PROC, 3, (X), (Y), (Z))
dicarloj 9:2a47b9ff8911 153 //#define procargs(X) ((X)->p[0])
dicarloj 9:2a47b9ff8911 154 //#define proccode(X) ((X)->p[1])
dicarloj 9:2a47b9ff8911 155 //#define procenv(X) ((X)->p[2])
dicarloj 9:2a47b9ff8911 156 //#define isnil(X) ((X) == nil)
dicarloj 9:2a47b9ff8911 157 //
dicarloj 9:2a47b9ff8911 158 //obj *omake(enum otype type, int count, ...) {
dicarloj 9:2a47b9ff8911 159 // obj *ret;
dicarloj 9:2a47b9ff8911 160 // va_list ap;
dicarloj 9:2a47b9ff8911 161 // int i;
dicarloj 9:2a47b9ff8911 162 // va_start(ap, count);
dicarloj 9:2a47b9ff8911 163 // int object_size = sizeof(obj) + (count - 1)*sizeof(obj *);
dicarloj 9:2a47b9ff8911 164 // total_malloc += object_size;
dicarloj 9:2a47b9ff8911 165 // if(type == INT)
dicarloj 9:2a47b9ff8911 166 // printf("malloc %d bytes for INT\r\n",object_size);
dicarloj 9:2a47b9ff8911 167 // if(type == SYM)
dicarloj 9:2a47b9ff8911 168 // printf("malloc %d bytes for SYM\r\n",object_size);
dicarloj 9:2a47b9ff8911 169 // if(type == CONS)
dicarloj 9:2a47b9ff8911 170 // printf("malloc %d bytes for CONS\r\n",object_size);
dicarloj 9:2a47b9ff8911 171 // if(type == SYM)
dicarloj 9:2a47b9ff8911 172 // printf("malloc %d bytes for PROC\r\n",object_size);
dicarloj 9:2a47b9ff8911 173 // if(type == PRIMOP)
dicarloj 9:2a47b9ff8911 174 // printf("malloc %d bytes for PRIMOP\r\n",object_size);
dicarloj 9:2a47b9ff8911 175 //
dicarloj 9:2a47b9ff8911 176 ////enum otype { INT, SYM, CONS, PROC, PRIMOP };
dicarloj 9:2a47b9ff8911 177 // ret = (obj *) malloc(object_size);
dicarloj 9:2a47b9ff8911 178 // ret->type = type;
dicarloj 9:2a47b9ff8911 179 // ret->line_num = line_num;
dicarloj 9:2a47b9ff8911 180 // for(i = 0; i < count; i++) ret->p[i] = va_arg(ap, obj *);
dicarloj 9:2a47b9ff8911 181 // va_end(ap);
dicarloj 9:2a47b9ff8911 182 // return ret;
dicarloj 9:2a47b9ff8911 183 //}
dicarloj 9:2a47b9ff8911 184 //
dicarloj 9:2a47b9ff8911 185 //obj *findsym(char *name) {
dicarloj 9:2a47b9ff8911 186 // obj *symlist;
dicarloj 9:2a47b9ff8911 187 // for(symlist = all_symbols; !isnil(symlist); symlist = cdr(symlist))
dicarloj 9:2a47b9ff8911 188 // if(!strcmp(name, symname(car(symlist))))
dicarloj 9:2a47b9ff8911 189 // return symlist;
dicarloj 9:2a47b9ff8911 190 // return nil;
dicarloj 9:2a47b9ff8911 191 //}
dicarloj 9:2a47b9ff8911 192 //
dicarloj 9:2a47b9ff8911 193 //obj *intern(char *name) {
dicarloj 9:2a47b9ff8911 194 // obj *op = findsym(name);
dicarloj 9:2a47b9ff8911 195 // if(!isnil(op)) return car(op);
dicarloj 9:2a47b9ff8911 196 // op = mksym(name);
dicarloj 9:2a47b9ff8911 197 // all_symbols = cons(op, all_symbols);
dicarloj 9:2a47b9ff8911 198 // return op;
dicarloj 9:2a47b9ff8911 199 //}
dicarloj 9:2a47b9ff8911 200 //
dicarloj 9:2a47b9ff8911 201 ///*** Environment ***/
dicarloj 9:2a47b9ff8911 202 //#define extend(ENV, SYM, VAL) (cons(cons((SYM), (VAL)), (ENV)))
dicarloj 9:2a47b9ff8911 203 //
dicarloj 9:2a47b9ff8911 204 //obj *multiple_extend(obj *env, obj *syms, obj *vals) {
dicarloj 9:2a47b9ff8911 205 // return isnil(syms) ?
dicarloj 9:2a47b9ff8911 206 // env :
dicarloj 9:2a47b9ff8911 207 // multiple_extend(extend(env, car(syms), car(vals)),
dicarloj 9:2a47b9ff8911 208 // cdr(syms), cdr(vals));
dicarloj 9:2a47b9ff8911 209 //}
dicarloj 9:2a47b9ff8911 210 //
dicarloj 9:2a47b9ff8911 211 //obj *extend_top(obj *sym, obj *val) {
dicarloj 9:2a47b9ff8911 212 // setcdr(top_env, cons(cons(sym, val), cdr(top_env)));
dicarloj 9:2a47b9ff8911 213 // return val;
dicarloj 9:2a47b9ff8911 214 //}
dicarloj 9:2a47b9ff8911 215 //
dicarloj 9:2a47b9ff8911 216 //obj *assoc(obj *key, obj *alist) {
dicarloj 9:2a47b9ff8911 217 // if(isnil(alist)) return nil;
dicarloj 9:2a47b9ff8911 218 // if(car(car(alist)) == key) return car(alist);
dicarloj 9:2a47b9ff8911 219 // return assoc(key, cdr(alist));
dicarloj 9:2a47b9ff8911 220 //}
dicarloj 9:2a47b9ff8911 221 //
dicarloj 9:2a47b9ff8911 222 ///*** Input/Output ***/
dicarloj 9:2a47b9ff8911 223 ////FILE *ifp;
dicarloj 9:2a47b9ff8911 224 //char *token_la;
dicarloj 9:2a47b9ff8911 225 //int la_valid = 0;
dicarloj 9:2a47b9ff8911 226 //#define MAXLEN 100
dicarloj 9:2a47b9ff8911 227 //char buf[MAXLEN];
dicarloj 9:2a47b9ff8911 228 //int bufused;
dicarloj 9:2a47b9ff8911 229 //
dicarloj 9:2a47b9ff8911 230 //void add_to_buf(char ch) { if(bufused < MAXLEN - 1) buf[bufused++] = ch; }
dicarloj 9:2a47b9ff8911 231 //char *buf2str() { buf[bufused++] = '\0'; return strdup_2(buf); }
dicarloj 9:2a47b9ff8911 232 ////void setinput(FILE *fp) { ifp = fp; }
dicarloj 9:2a47b9ff8911 233 //void putback_token(char *token) { token_la = token; la_valid = 1; }
dicarloj 9:2a47b9ff8911 234 //
dicarloj 9:2a47b9ff8911 235 //void myexit(int code);
dicarloj 9:2a47b9ff8911 236 //
dicarloj 9:2a47b9ff8911 237 //char *gettoken() {
dicarloj 9:2a47b9ff8911 238 // int ch;
dicarloj 9:2a47b9ff8911 239 // char comment=0;
dicarloj 9:2a47b9ff8911 240 //
dicarloj 9:2a47b9ff8911 241 // bufused = 0;
dicarloj 9:2a47b9ff8911 242 // if(la_valid) { la_valid = 0; return token_la; }
dicarloj 9:2a47b9ff8911 243 // do {
dicarloj 9:2a47b9ff8911 244 // if((ch = getc_2()) == EOF) {myexit(0); return NULL;} // replace with serial
dicarloj 9:2a47b9ff8911 245 // //draw_vincent_string("gettoken");
dicarloj 9:2a47b9ff8911 246 // if(ch == ';') comment = 1;
dicarloj 9:2a47b9ff8911 247 // if(ch == '\n') {
dicarloj 9:2a47b9ff8911 248 // comment = 0;
dicarloj 9:2a47b9ff8911 249 // line_num++;
dicarloj 9:2a47b9ff8911 250 // }
dicarloj 9:2a47b9ff8911 251 //
dicarloj 9:2a47b9ff8911 252 // } while(isspace(ch) || comment);
dicarloj 9:2a47b9ff8911 253 //
dicarloj 9:2a47b9ff8911 254 //
dicarloj 9:2a47b9ff8911 255 // add_to_buf(ch);
dicarloj 9:2a47b9ff8911 256 // if(strchr("()\'", ch)) return buf2str();
dicarloj 9:2a47b9ff8911 257 // for(;;) {
dicarloj 9:2a47b9ff8911 258 // if(lisp_exit) { return NULL; }
dicarloj 9:2a47b9ff8911 259 // if((ch = getc_2()) == EOF) {myexit(0); return NULL;}
dicarloj 9:2a47b9ff8911 260 // if(strchr("()\'", ch) || isspace(ch)) {
dicarloj 9:2a47b9ff8911 261 // ungetc_2(ch);
dicarloj 9:2a47b9ff8911 262 // return buf2str();
dicarloj 9:2a47b9ff8911 263 // }
dicarloj 9:2a47b9ff8911 264 // add_to_buf(ch);
dicarloj 9:2a47b9ff8911 265 // }
dicarloj 9:2a47b9ff8911 266 //}
dicarloj 9:2a47b9ff8911 267 //
dicarloj 9:2a47b9ff8911 268 //obj *readlist();
dicarloj 9:2a47b9ff8911 269 //
dicarloj 9:2a47b9ff8911 270 //obj *readobj() {
dicarloj 9:2a47b9ff8911 271 // char *token;
dicarloj 9:2a47b9ff8911 272 //
dicarloj 9:2a47b9ff8911 273 // token = gettoken();
dicarloj 9:2a47b9ff8911 274 // if(token == NULL) return NULL;
dicarloj 9:2a47b9ff8911 275 // if(!strcmp(token, "(")) return readlist();
dicarloj 9:2a47b9ff8911 276 // if(!strcmp(token, "\'")) return cons(quote, cons(readobj(), nil));
dicarloj 9:2a47b9ff8911 277 //
dicarloj 9:2a47b9ff8911 278 // if(token[strspn(token, "0123456789")] == '\0'
dicarloj 9:2a47b9ff8911 279 // || (token[0] == '-' && strlen(token) > 1))
dicarloj 9:2a47b9ff8911 280 // return mkint(atoi(token));
dicarloj 9:2a47b9ff8911 281 // return intern(token);
dicarloj 9:2a47b9ff8911 282 //}
dicarloj 9:2a47b9ff8911 283 //
dicarloj 9:2a47b9ff8911 284 //obj *readlist() {
dicarloj 9:2a47b9ff8911 285 // char *token = gettoken();
dicarloj 9:2a47b9ff8911 286 // if(token == NULL) return NULL;
dicarloj 9:2a47b9ff8911 287 // obj *tmp;
dicarloj 9:2a47b9ff8911 288 // if(!strcmp(token, ")")) return nil;
dicarloj 9:2a47b9ff8911 289 // if(!strcmp(token, ".")) {
dicarloj 9:2a47b9ff8911 290 // tmp = readobj();
dicarloj 9:2a47b9ff8911 291 // if(strcmp(gettoken(), ")")) myexit(1);
dicarloj 9:2a47b9ff8911 292 // return tmp;
dicarloj 9:2a47b9ff8911 293 // }
dicarloj 9:2a47b9ff8911 294 // putback_token(token);
dicarloj 9:2a47b9ff8911 295 // tmp = readobj(); /* Must force evaluation order */
dicarloj 9:2a47b9ff8911 296 // return cons(tmp, readlist());
dicarloj 9:2a47b9ff8911 297 //}
dicarloj 9:2a47b9ff8911 298 //
dicarloj 9:2a47b9ff8911 299 //void writeobj(obj *op) {
dicarloj 9:2a47b9ff8911 300 //
dicarloj 9:2a47b9ff8911 301 // if(op == NULL) { return; }
dicarloj 9:2a47b9ff8911 302 // switch(op->type) {
dicarloj 9:2a47b9ff8911 303 // case INT: sprintf(out_buf + strlen(out_buf),"%d", intval(op)); break;
dicarloj 9:2a47b9ff8911 304 // case CONS:
dicarloj 9:2a47b9ff8911 305 // //draw_vincent_string(" write_cons ");
dicarloj 9:2a47b9ff8911 306 // sprintf(out_buf + strlen(out_buf),"(");
dicarloj 9:2a47b9ff8911 307 // for(;;) {
dicarloj 9:2a47b9ff8911 308 // writeobj(car(op));
dicarloj 9:2a47b9ff8911 309 // if(isnil(cdr(op))) {
dicarloj 9:2a47b9ff8911 310 // sprintf(out_buf + strlen(out_buf),")");
dicarloj 9:2a47b9ff8911 311 // break;
dicarloj 9:2a47b9ff8911 312 // }
dicarloj 9:2a47b9ff8911 313 // op = cdr(op);
dicarloj 9:2a47b9ff8911 314 // if(op->type != CONS) {
dicarloj 9:2a47b9ff8911 315 // sprintf(out_buf + strlen(out_buf)," . ");
dicarloj 9:2a47b9ff8911 316 // writeobj(op);
dicarloj 9:2a47b9ff8911 317 // sprintf(out_buf + strlen(out_buf),")");
dicarloj 9:2a47b9ff8911 318 // break;
dicarloj 9:2a47b9ff8911 319 // }
dicarloj 9:2a47b9ff8911 320 // sprintf(out_buf + strlen(out_buf)," ");
dicarloj 9:2a47b9ff8911 321 // }
dicarloj 9:2a47b9ff8911 322 // break;
dicarloj 9:2a47b9ff8911 323 // case SYM:
dicarloj 9:2a47b9ff8911 324 //
dicarloj 9:2a47b9ff8911 325 // if(isnil(op)) sprintf(out_buf + strlen(out_buf),"()");
dicarloj 9:2a47b9ff8911 326 // else sprintf(out_buf + strlen(out_buf),"%s", symname(op));
dicarloj 9:2a47b9ff8911 327 // break;
dicarloj 9:2a47b9ff8911 328 // case PRIMOP: sprintf(out_buf + strlen(out_buf),"#<PRIMOP>"); break;
dicarloj 9:2a47b9ff8911 329 // case PROC: sprintf(out_buf + strlen(out_buf),"#<PROC>"); break;
dicarloj 9:2a47b9ff8911 330 // default: myexit(1);
dicarloj 9:2a47b9ff8911 331 // }
dicarloj 9:2a47b9ff8911 332 //}
dicarloj 9:2a47b9ff8911 333 //
dicarloj 9:2a47b9ff8911 334 ///*** Evaluator (Eval/no Apply) ***/
dicarloj 9:2a47b9ff8911 335 //obj *evlis(obj *exps, obj *env);
dicarloj 9:2a47b9ff8911 336 //
dicarloj 9:2a47b9ff8911 337 //obj *eval(obj *exp, obj *env) {
dicarloj 9:2a47b9ff8911 338 // if(lisp_exit) return NULL;
dicarloj 9:2a47b9ff8911 339 // obj *tmp, *proc, *vals;
dicarloj 9:2a47b9ff8911 340 //
dicarloj 9:2a47b9ff8911 341 // eval_start:
dicarloj 9:2a47b9ff8911 342 //
dicarloj 9:2a47b9ff8911 343 // if(exp == NULL) return nil;
dicarloj 9:2a47b9ff8911 344 // if(exp == nil) return nil;
dicarloj 9:2a47b9ff8911 345 //
dicarloj 9:2a47b9ff8911 346 //
dicarloj 9:2a47b9ff8911 347 // switch(exp->type) {
dicarloj 9:2a47b9ff8911 348 // case INT: return exp;
dicarloj 9:2a47b9ff8911 349 // case SYM: tmp = assoc(exp, env);
dicarloj 9:2a47b9ff8911 350 //
dicarloj 9:2a47b9ff8911 351 // if(tmp == nil) {
dicarloj 9:2a47b9ff8911 352 // sprintf(out_buf + strlen(out_buf), "Unbound symbol ");
dicarloj 9:2a47b9ff8911 353 // writeobj(exp);
dicarloj 9:2a47b9ff8911 354 // sprintf(out_buf + strlen(out_buf), "\n");
dicarloj 9:2a47b9ff8911 355 // return nil;
dicarloj 9:2a47b9ff8911 356 // }
dicarloj 9:2a47b9ff8911 357 // return cdr(tmp);
dicarloj 9:2a47b9ff8911 358 //
dicarloj 9:2a47b9ff8911 359 //
dicarloj 9:2a47b9ff8911 360 //
dicarloj 9:2a47b9ff8911 361 // case CONS:
dicarloj 9:2a47b9ff8911 362 // if(car(exp) == s_if) {
dicarloj 9:2a47b9ff8911 363 // if(eval(car(cdr(exp)), env) != nil)
dicarloj 9:2a47b9ff8911 364 // return eval(car(cdr(cdr(exp))), env);
dicarloj 9:2a47b9ff8911 365 // else
dicarloj 9:2a47b9ff8911 366 // return eval(car(cdr(cdr(cdr(exp)))), env);
dicarloj 9:2a47b9ff8911 367 // }
dicarloj 9:2a47b9ff8911 368 // if(car(exp) == s_lambda)
dicarloj 9:2a47b9ff8911 369 // return mkproc(car(cdr(exp)), cdr(cdr(exp)), env);
dicarloj 9:2a47b9ff8911 370 // if(car(exp) == quote)
dicarloj 9:2a47b9ff8911 371 // return car(cdr(exp));
dicarloj 9:2a47b9ff8911 372 // if(car(exp) == s_define)
dicarloj 9:2a47b9ff8911 373 // return(extend_top(car(cdr(exp)),
dicarloj 9:2a47b9ff8911 374 // eval(car(cdr(cdr(exp))), env)));
dicarloj 9:2a47b9ff8911 375 // if(car(exp) == s_setb) {
dicarloj 9:2a47b9ff8911 376 // obj *pair = assoc(car(cdr(exp)), env);
dicarloj 9:2a47b9ff8911 377 // obj *newval = eval(car(cdr(cdr(exp))), env);
dicarloj 9:2a47b9ff8911 378 // setcdr(pair, newval);
dicarloj 9:2a47b9ff8911 379 // return newval;
dicarloj 9:2a47b9ff8911 380 // }
dicarloj 9:2a47b9ff8911 381 // if(car(exp) == s_begin) {
dicarloj 9:2a47b9ff8911 382 // exp = cdr(exp);
dicarloj 9:2a47b9ff8911 383 // if(exp == nil) return nil;
dicarloj 9:2a47b9ff8911 384 // for(;;) {
dicarloj 9:2a47b9ff8911 385 // if(cdr(exp) == nil) {
dicarloj 9:2a47b9ff8911 386 // exp = car(exp);
dicarloj 9:2a47b9ff8911 387 // goto eval_start;
dicarloj 9:2a47b9ff8911 388 // }
dicarloj 9:2a47b9ff8911 389 // eval(car(exp), env);
dicarloj 9:2a47b9ff8911 390 // exp = cdr(exp);
dicarloj 9:2a47b9ff8911 391 // }
dicarloj 9:2a47b9ff8911 392 // }
dicarloj 9:2a47b9ff8911 393 // proc = eval(car(exp), env);
dicarloj 9:2a47b9ff8911 394 // vals = evlis(cdr(exp), env);
dicarloj 9:2a47b9ff8911 395 // if(proc->type == PRIMOP)
dicarloj 9:2a47b9ff8911 396 // return (*primopval(proc))(vals);
dicarloj 9:2a47b9ff8911 397 // if(proc->type == PROC) {
dicarloj 9:2a47b9ff8911 398 // /* For dynamic scope, use env instead of procenv(proc) */
dicarloj 9:2a47b9ff8911 399 // env = multiple_extend(procenv(proc), procargs(proc), vals);
dicarloj 9:2a47b9ff8911 400 // exp = cons(s_begin, proccode(proc));
dicarloj 9:2a47b9ff8911 401 // goto eval_start;
dicarloj 9:2a47b9ff8911 402 // }
dicarloj 9:2a47b9ff8911 403 // sprintf(out_buf + strlen(out_buf),"Bad PROC type\n");
dicarloj 9:2a47b9ff8911 404 // return nil;
dicarloj 9:2a47b9ff8911 405 // case PRIMOP: return exp;
dicarloj 9:2a47b9ff8911 406 // case PROC: return exp;
dicarloj 9:2a47b9ff8911 407 // }
dicarloj 9:2a47b9ff8911 408 // /* Not reached */
dicarloj 9:2a47b9ff8911 409 // return exp;
dicarloj 9:2a47b9ff8911 410 //}
dicarloj 9:2a47b9ff8911 411 //
dicarloj 9:2a47b9ff8911 412 //obj *evlis(obj *exps, obj *env) {
dicarloj 9:2a47b9ff8911 413 // if(exps == nil) return nil;
dicarloj 9:2a47b9ff8911 414 // return cons(eval(car(exps), env),
dicarloj 9:2a47b9ff8911 415 // evlis(cdr(exps), env));
dicarloj 9:2a47b9ff8911 416 //}
dicarloj 9:2a47b9ff8911 417 //
dicarloj 9:2a47b9ff8911 418 ///*** Primitives ***/
dicarloj 9:2a47b9ff8911 419 //obj *prim_sum(obj *args) {
dicarloj 9:2a47b9ff8911 420 // int sum;
dicarloj 9:2a47b9ff8911 421 // for(sum = 0; !isnil(args); sum += intval(car(args)), args = cdr(args));
dicarloj 9:2a47b9ff8911 422 // return mkint(sum);
dicarloj 9:2a47b9ff8911 423 //}
dicarloj 9:2a47b9ff8911 424 //
dicarloj 9:2a47b9ff8911 425 //obj *prim_sub(obj *args) {
dicarloj 9:2a47b9ff8911 426 // int sum;
dicarloj 9:2a47b9ff8911 427 // for(sum = intval(car(args)), args = cdr(args);
dicarloj 9:2a47b9ff8911 428 // !isnil(args);
dicarloj 9:2a47b9ff8911 429 // sum -= intval(car(args)), args = cdr(args));
dicarloj 9:2a47b9ff8911 430 // return mkint(sum);
dicarloj 9:2a47b9ff8911 431 //}
dicarloj 9:2a47b9ff8911 432 //
dicarloj 9:2a47b9ff8911 433 //obj *prim_prod(obj *args) {
dicarloj 9:2a47b9ff8911 434 // int prod;
dicarloj 9:2a47b9ff8911 435 // for(prod = 1; !isnil(args); prod *= intval(car(args)), args = cdr(args));
dicarloj 9:2a47b9ff8911 436 // return mkint(prod);
dicarloj 9:2a47b9ff8911 437 //}
dicarloj 9:2a47b9ff8911 438 //obj *prim_divide(obj *args) {
dicarloj 9:2a47b9ff8911 439 // int prod = intval(car(args));
dicarloj 9:2a47b9ff8911 440 // args = cdr(args);
dicarloj 9:2a47b9ff8911 441 // while(!isnil(args)) {
dicarloj 9:2a47b9ff8911 442 // prod /= intval(car(args));
dicarloj 9:2a47b9ff8911 443 // args = cdr(args);
dicarloj 9:2a47b9ff8911 444 // }
dicarloj 9:2a47b9ff8911 445 //
dicarloj 9:2a47b9ff8911 446 // return mkint(prod);
dicarloj 9:2a47b9ff8911 447 //}
dicarloj 9:2a47b9ff8911 448 //
dicarloj 9:2a47b9ff8911 449 //obj *prim_gt(obj *args) {
dicarloj 9:2a47b9ff8911 450 // return intval(car(args)) > intval(car(cdr(args))) ? tee : nil;
dicarloj 9:2a47b9ff8911 451 //}
dicarloj 9:2a47b9ff8911 452 //
dicarloj 9:2a47b9ff8911 453 //obj *prim_lt(obj *args) {
dicarloj 9:2a47b9ff8911 454 // return intval(car(args)) < intval(car(cdr(args))) ? tee : nil;
dicarloj 9:2a47b9ff8911 455 //}
dicarloj 9:2a47b9ff8911 456 //obj *prim_ge(obj *args) {
dicarloj 9:2a47b9ff8911 457 // return intval(car(args)) >= intval(car(cdr(args))) ? tee : nil;
dicarloj 9:2a47b9ff8911 458 //}
dicarloj 9:2a47b9ff8911 459 //obj *prim_le(obj *args) {
dicarloj 9:2a47b9ff8911 460 // return intval(car(args)) <= intval(car(cdr(args))) ? tee : nil;
dicarloj 9:2a47b9ff8911 461 //}
dicarloj 9:2a47b9ff8911 462 //obj *prim_numeq(obj *args) {
dicarloj 9:2a47b9ff8911 463 // return intval(car(args)) == intval(car(cdr(args))) ? tee : nil;
dicarloj 9:2a47b9ff8911 464 //}
dicarloj 9:2a47b9ff8911 465 //
dicarloj 9:2a47b9ff8911 466 //obj *prim_cons(obj *args) { return cons(car(args), car(cdr(args))); }
dicarloj 9:2a47b9ff8911 467 //obj *prim_car(obj *args) { return car(car(args)); }
dicarloj 9:2a47b9ff8911 468 //obj *prim_cdr(obj *args) { return cdr(car(args)); }
dicarloj 9:2a47b9ff8911 469 //
dicarloj 9:2a47b9ff8911 470 //
dicarloj 9:2a47b9ff8911 471 ///*** Helpers *****/
dicarloj 9:2a47b9ff8911 472 //
dicarloj 9:2a47b9ff8911 473 //obj *prim_print(obj *args) {
dicarloj 9:2a47b9ff8911 474 // while(!isnil(args)) {
dicarloj 9:2a47b9ff8911 475 // writeobj(car(args));
dicarloj 9:2a47b9ff8911 476 // args = cdr(args);
dicarloj 9:2a47b9ff8911 477 // sprintf(out_buf + strlen(out_buf)," ");
dicarloj 9:2a47b9ff8911 478 // }
dicarloj 9:2a47b9ff8911 479 // sprintf(out_buf + strlen(out_buf),"\n");
dicarloj 9:2a47b9ff8911 480 // return nil;
dicarloj 9:2a47b9ff8911 481 //}
dicarloj 9:2a47b9ff8911 482 //
dicarloj 9:2a47b9ff8911 483 ///*** Initialization ***/
dicarloj 9:2a47b9ff8911 484 //void init_sl3() {
dicarloj 9:2a47b9ff8911 485 // nil = mksym("nil");
dicarloj 9:2a47b9ff8911 486 // all_symbols = cons(nil, nil);
dicarloj 9:2a47b9ff8911 487 // top_env = cons(cons(nil, nil), nil);
dicarloj 9:2a47b9ff8911 488 // tee = intern("t");
dicarloj 9:2a47b9ff8911 489 // extend_top(tee, tee);
dicarloj 9:2a47b9ff8911 490 // quote = intern("quote");
dicarloj 9:2a47b9ff8911 491 // s_if = intern("if");
dicarloj 9:2a47b9ff8911 492 // s_lambda = intern("lambda");
dicarloj 9:2a47b9ff8911 493 // s_define = intern("define");
dicarloj 9:2a47b9ff8911 494 // s_setb = intern("set!");
dicarloj 9:2a47b9ff8911 495 // s_begin = intern("begin");
dicarloj 9:2a47b9ff8911 496 // extend_top(intern("+"), mkprimop(prim_sum));
dicarloj 9:2a47b9ff8911 497 // extend_top(intern("-"), mkprimop(prim_sub));
dicarloj 9:2a47b9ff8911 498 // extend_top(intern("*"), mkprimop(prim_prod));
dicarloj 9:2a47b9ff8911 499 // extend_top(intern("/"), mkprimop(prim_divide));
dicarloj 9:2a47b9ff8911 500 // extend_top(intern("="), mkprimop(prim_numeq));
dicarloj 9:2a47b9ff8911 501 //
dicarloj 9:2a47b9ff8911 502 // extend_top(intern(">"), mkprimop(prim_gt));
dicarloj 9:2a47b9ff8911 503 // extend_top(intern(">="), mkprimop(prim_ge));
dicarloj 9:2a47b9ff8911 504 //
dicarloj 9:2a47b9ff8911 505 // extend_top(intern("<"), mkprimop(prim_lt));
dicarloj 9:2a47b9ff8911 506 // extend_top(intern("<="), mkprimop(prim_le));
dicarloj 9:2a47b9ff8911 507 //
dicarloj 9:2a47b9ff8911 508 // extend_top(intern("cons"), mkprimop(prim_cons));
dicarloj 9:2a47b9ff8911 509 // extend_top(intern("car"), mkprimop(prim_car));
dicarloj 9:2a47b9ff8911 510 // extend_top(intern("cdr"), mkprimop(prim_cdr));
dicarloj 9:2a47b9ff8911 511 //
dicarloj 9:2a47b9ff8911 512 // extend_top(intern("print"), mkprimop(prim_print));
dicarloj 9:2a47b9ff8911 513 //}
dicarloj 9:2a47b9ff8911 514 //
dicarloj 9:2a47b9ff8911 515 //char* get_output()
dicarloj 9:2a47b9ff8911 516 //{
dicarloj 9:2a47b9ff8911 517 // return out_buf;
dicarloj 9:2a47b9ff8911 518 //}
dicarloj 9:2a47b9ff8911 519 //
dicarloj 9:2a47b9ff8911 520 //int lisp_init = 0;
dicarloj 9:2a47b9ff8911 521 //
dicarloj 9:2a47b9ff8911 522 ///*** Main Driver ***/
dicarloj 9:2a47b9ff8911 523 //int run_lisp(char* input) {
dicarloj 9:2a47b9ff8911 524 // if(!lisp_init)
dicarloj 9:2a47b9ff8911 525 // {
dicarloj 9:2a47b9ff8911 526 // init_sl3();
dicarloj 9:2a47b9ff8911 527 // lisp_init = 1;
dicarloj 9:2a47b9ff8911 528 // }
dicarloj 9:2a47b9ff8911 529 //
dicarloj 9:2a47b9ff8911 530 // init_buf();
dicarloj 9:2a47b9ff8911 531 //
dicarloj 9:2a47b9ff8911 532 //
dicarloj 9:2a47b9ff8911 533 // lisp_exit = 0;
dicarloj 9:2a47b9ff8911 534 // strcpy(in_buf, input);
dicarloj 9:2a47b9ff8911 535 // if(!strncmp(input,"clear",4)){ clear_all_text(); return 0; }
dicarloj 9:2a47b9ff8911 536 // if(!strncmp(input,"mem",3))
dicarloj 9:2a47b9ff8911 537 // {
dicarloj 9:2a47b9ff8911 538 // char memuse[40];
dicarloj 9:2a47b9ff8911 539 // sprintf(memuse,"MEM: %d bytes",total_malloc);
dicarloj 9:2a47b9ff8911 540 // draw_vincent_string(memuse);
dicarloj 9:2a47b9ff8911 541 // return;
dicarloj 9:2a47b9ff8911 542 // }
dicarloj 9:2a47b9ff8911 543 // in_buf[in_buf_size - 1] = 0;
dicarloj 9:2a47b9ff8911 544 // //new_line();
dicarloj 9:2a47b9ff8911 545 // //draw_vincent_string(in_buf);
dicarloj 9:2a47b9ff8911 546 // //new_line();
dicarloj 9:2a47b9ff8911 547 // //print_vincent_string(in_buf);
dicarloj 9:2a47b9ff8911 548 //// if(argc == 2)
dicarloj 9:2a47b9ff8911 549 //// {
dicarloj 9:2a47b9ff8911 550 //// memcpy(in_buf,argv[1],strlen(argv[1]));
dicarloj 9:2a47b9ff8911 551 //// printf("%s\n",in_buf);
dicarloj 9:2a47b9ff8911 552 //// }
dicarloj 9:2a47b9ff8911 553 //// else
dicarloj 9:2a47b9ff8911 554 // //sprintf(in_buf,"(+ 2 2)\n");
dicarloj 9:2a47b9ff8911 555 //// char test_in[] = "(+ 2 2)\n";
dicarloj 9:2a47b9ff8911 556 //// FILE* input_stream = open_memstream(test_in,8);
dicarloj 9:2a47b9ff8911 557 //// fprintf(input_stream,"(+ 2 3)\n");
dicarloj 9:2a47b9ff8911 558 //// char test_out[50];
dicarloj 9:2a47b9ff8911 559 //// FILE* output_stream = fmemopen(test_out,50,"w");
dicarloj 9:2a47b9ff8911 560 // //setinput(input_stream);
dicarloj 9:2a47b9ff8911 561 // int lisp_count = 0;
dicarloj 9:2a47b9ff8911 562 // while(!lisp_exit) {
dicarloj 9:2a47b9ff8911 563 // writeobj(eval(readobj(), top_env));
dicarloj 9:2a47b9ff8911 564 // //fflush(output_stream);
dicarloj 9:2a47b9ff8911 565 // printf("\n");
dicarloj 9:2a47b9ff8911 566 // printf("%s\n",out_buf);
dicarloj 9:2a47b9ff8911 567 //
dicarloj 9:2a47b9ff8911 568 // lisp_count++;
dicarloj 9:2a47b9ff8911 569 // if(lisp_count > 500) break;
dicarloj 9:2a47b9ff8911 570 // //printf("outstream: %s\n",test_out);
dicarloj 9:2a47b9ff8911 571 // }
dicarloj 9:2a47b9ff8911 572 // draw_vincent_string(out_buf);
dicarloj 9:2a47b9ff8911 573 // //draw_vincent_string("done!");
dicarloj 9:2a47b9ff8911 574 // return 0;
dicarloj 9:2a47b9ff8911 575 //}
dicarloj 9:2a47b9ff8911 576 //
dicarloj 9:2a47b9ff8911 577 //void myexit(int code) {
dicarloj 9:2a47b9ff8911 578 // printf("%d bytes left hanging\n", total_malloc);
dicarloj 9:2a47b9ff8911 579 // lisp_exit = 1;
dicarloj 9:2a47b9ff8911 580 //}