├── .gitignore
├── CMakeLists.txt
├── LICENSE
├── README.md
├── bin
    └── .gitkeep
├── lisp.c
├── test.sh
└── test
    ├── EuclideanAlgorithm.scm
    ├── ackermann.scm
    ├── and.scm
    ├── bool.scm
    ├── bool_real1.scm
    ├── bool_real2.scm
    ├── comment.scm
    ├── cul.scm
    ├── define.scm
    ├── define2.scm
    ├── fact.scm
    ├── fibonacci.scm
    ├── fibonacci2.scm
    ├── func.scm
    ├── if.scm
    ├── lambda.scm
    ├── lambda2.scm
    ├── list.scm
    ├── listfunc.scm
    ├── lists.scm
    ├── mod.scm
    ├── name.scm
    ├── name_adv.scm
    ├── neg.scm
    ├── neg2.scm
    ├── neg_real.scm
    ├── newton.scm
    ├── or.scm
    ├── print.scm
    ├── real_dev.scm
    ├── real_minus.scm
    ├── real_plus.scm
    ├── real_time.scm
    ├── realtype.scm
    └── recursion.scm


/.gitignore:
--------------------------------------------------------------------------------
 1 | .DS_Store
 2 | CMakeCache.txt
 3 | CMakeFiles
 4 | cmake_install.cmake
 5 | Makefile
 6 | DEBUG
 7 | DEBUG.dSYM
 8 | lisp
 9 | TAGS
10 | *.o
11 | 


--------------------------------------------------------------------------------
/CMakeLists.txt:
--------------------------------------------------------------------------------
1 | cmake_minimum_required(VERSION 2.8)
2 | add_definitions("-Wall -g") 
3 | add_executable(bin/lisp lisp.c)
4 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | The MIT License (MIT)
 2 | 
 3 | Copyright (c) 2016 Shin KAWAHARA
 4 | 
 5 | Permission is hereby granted, free of charge, to any person obtaining a copy
 6 | of this software and associated documentation files (the "Software"), to deal
 7 | in the Software without restriction, including without limitation the rights
 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 | 
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 | 
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 | SOFTWARE.
22 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # microlisp
 2 | 
 3 | [![MIT License](http://img.shields.io/badge/license-MIT-blue.svg?style=flat)](LICENSE)
 4 | 
 5 | Small LISP Interpreter.
 6 | 
 7 | ## Documentation
 8 | 
 9 | This is a Lisp interpreter, which is so small, easy to read and understand. (no GC)
10 | 
11 | ## BUILD
12 | 
13 | ```console
14 | $ cmake .
15 | 
16 | $ make
17 | ```
18 | 
19 | ### RUN
20 | 
21 | ```console
22 | $ ./bin/lisp <file>
23 | ```
24 | 
25 | ### TEST
26 | 
27 | ```console
28 | $ cat test.sh | bash
29 | ```
30 | 
31 | ### CLEAN
32 | 
33 | ```console
34 | $ make clean
35 | ```
36 | 
37 | ## Author
38 | 
39 | Shin KAWAHARA
40 | 


--------------------------------------------------------------------------------
/bin/.gitkeep:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/shinkwhek/microlisp/c7bd05adc3981cbab399d05e840165fc169505b2/bin/.gitkeep


--------------------------------------------------------------------------------
/lisp.c:
--------------------------------------------------------------------------------
  1 | #include<stdio.h>
  2 | #include<stdlib.h>
  3 | #include<ctype.h>
  4 | #include<string.h>
  5 | 
  6 | FILE * fp;
  7 | int c;		// current
  8 | int flag_list;
  9 | 
 10 | /* ==== ==== ==== type ==== ==== ==== */
 11 | enum {
 12 |   TNIL = 0,
 13 |   TUNIT,
 14 |   TENV,
 15 |   TTRUE,
 16 |   TFALSE,
 17 |   TSYMBOL,
 18 |   TCONS,
 19 |   TLIST,
 20 |   TFUN,
 21 |   TINT,
 22 |   TREAL
 23 | };
 24 | 
 25 | struct cell_s;
 26 | 
 27 | typedef struct cell_s {
 28 |   int type_;
 29 |   union {
 30 |     // data
 31 |     int int_;
 32 |     float real_;
 33 |     char * symbol_;
 34 |     struct cell_s * car_;
 35 |   };
 36 |   struct cell_s * cdr_;
 37 | } Cell;
 38 | 
 39 | static Cell * Nil   = &(Cell){ TNIL,   .int_ = 0 };
 40 | static Cell * TRUE  = &(Cell){ TTRUE,  .int_ = 1 };
 41 | static Cell * FALSE = &(Cell){ TFALSE, .int_ = 0 };
 42 | 
 43 | static const char symbols[] = "+-*/!?=<>_:\\%#~&";
 44 | /* ==== ==== ==== ==== ==== ==== ==== */
 45 | 
 46 | /* ---- ---- make cell ---- ---- */
 47 | static Cell * make_cell (Cell * cell) {
 48 |   Cell * r;
 49 |   if ((r = malloc(1 * sizeof(Cell))) == NULL) {
 50 |     printf("[error]: malloc\n");
 51 |     exit(-1);
 52 |   }
 53 |   *r = *cell;
 54 |   return r;
 55 | }
 56 | 
 57 | static Cell * cell_cons (Cell * cell) { return make_cell(&(Cell){ TCONS, .car_ = cell }); }
 58 | static Cell * cell_list (Cell * cell) { return make_cell(&(Cell){ TLIST, .car_ = cell }); }
 59 | static Cell * cell_int  (int a)       { return make_cell(&(Cell){ TINT, .int_=a });       }
 60 | static Cell * cell_real (float a)     { return make_cell(&(Cell){ TREAL, .real_=a});      }
 61 | static Cell * cell_symbol (char * a) {
 62 |   Cell * r = make_cell(&(Cell){ TSYMBOL, .int_ = 0 });
 63 |   r->symbol_ = malloc( sizeof(char) * (strlen(a)+1) );
 64 |   strcpy(r->symbol_, a);
 65 |   return r;
 66 | }
 67 | 
 68 | /* ---- ---- ---- ---- ---- ---- */
 69 | 
 70 | /* ---- ---- lex tools ---- ---- */
 71 | 
 72 | #define next \
 73 |   do { c = fgetc(fp); } while(0)
 74 | 
 75 | #define skip \
 76 |   do { next; } while(c != '\n')
 77 | 
 78 | static inline int show_next (void) {
 79 |   int a = fgetc(fp);
 80 |   ungetc(a, fp);
 81 |   return a;
 82 | }
 83 | 
 84 | static Cell * parse_num (int a, int neg) {
 85 |   int int_or_real = 0;
 86 |   int b    = a - '0';          // int
 87 |   float br = (float)(a - '0'); // real
 88 |   while (isdigit(show_next())){
 89 |     next;
 90 |     b  = b  * 10 + (int)(c - '0');   // int
 91 |     br = br * 10 + (float)(c - '0'); // real
 92 |   }
 93 |   if (show_next() == '.') {
 94 |     int_or_real = 1;
 95 |     next;
 96 |     int k = 0;
 97 |     while(isdigit(show_next())) {
 98 |       next;
 99 |       k++;
100 |       br = br * 10.0 + (float)(c - '0'); // real
101 |     }
102 |     for(int p = 0; p < k; p++) {
103 |       br = br / 10.0;
104 |     }
105 |   }
106 |   if (neg == 1) {
107 |     if (int_or_real == 0)
108 |       b = -b;
109 |     else
110 |       br = -br;
111 |   }
112 |   if (int_or_real == 0)
113 |     return cell_int(b);
114 |   else
115 |     return cell_real(br);
116 | }
117 | 
118 | static Cell * parse_symbol (char a) {
119 |   char buf[256];
120 |   buf[0] = a;
121 |   int s = 1;
122 |   while (isalpha(show_next()) || isdigit(show_next()) || strchr(symbols, show_next())) {
123 |     next;
124 |     buf[s++] = c;
125 |   }
126 |   buf[s] = '\0';
127 |   return cell_symbol(buf);
128 | }
129 | 
130 | /* ==== ==== ==== parser ==== ==== ==== */
131 | static Cell * parse (void) {
132 |   for(;;) {
133 |     next;
134 |     if (c == ';') { // comment
135 |       skip;
136 |       continue;
137 |     }
138 |     if (c == ' ' || c == '\t' || c == '\n' || c == '\r')
139 |       continue;
140 |     if (c == EOF)
141 |       return Nil;
142 |     if (c == '-' && isdigit(show_next())) {
143 |       next;
144 |       Cell * r = parse_num(c, 1);
145 |       r->cdr_ = parse();
146 |       return r;
147 |     }
148 |     if (isdigit(c)) {
149 |       Cell * r = parse_num(c, 0);
150 |       r->cdr_  = parse();
151 |       return r;
152 |     }
153 |     if (isalpha(c) || strchr(symbols,c)) {
154 |       Cell * r = parse_symbol(c);
155 |       r->cdr_  = parse();
156 |       return r;
157 |     }
158 |     if (c == '\'' && show_next() == '(') {
159 |       next;
160 |       flag_list = 1;
161 |       Cell * r = cell_list(parse());
162 |       flag_list = 0;
163 |       r->cdr_ = parse();
164 |       return r;
165 |     }
166 |     if (c == '(') {
167 |       Cell * r;
168 |       if (flag_list == 1) r = cell_list(parse());
169 |       else                r = cell_cons(parse());
170 |       r->cdr_  = parse();
171 |       return r;
172 |     }
173 |     if (c == ')') {
174 |       return Nil;
175 |     }
176 |   }
177 | }
178 | /* ==== ==== ==== ====== ==== ==== ==== */
179 | 
180 | /* ==== ==== ==== eval ==== ==== ==== */
181 | static inline Cell * plus_eval   (Cell*, Cell**);
182 | static inline Cell * minus_eval  (Cell*, Cell**);
183 | static inline Cell * time_eval   (Cell*, Cell**);
184 | static inline Cell * divid_eval  (Cell*, Cell**);
185 | static inline Cell * mod_eval    (Cell*, Cell**);
186 | static inline Cell * great_eval  (Cell*, Cell**);
187 | static inline Cell * less_eval   (Cell*, Cell**);
188 | static inline Cell * equal_eval  (Cell*, Cell**);
189 | static inline Cell * and_eval    (Cell*, Cell**);
190 | static inline Cell * or_eval     (Cell*, Cell**);
191 | static inline Cell * if_eval     (Cell*, Cell**);
192 | static inline Cell * car_eval    (Cell*, Cell**);
193 | static inline Cell * cdr_eval    (Cell*, Cell**);
194 | static inline Cell * list_eval   (Cell*, Cell**);
195 | static inline Cell * def_eval    (Cell*, Cell**);
196 | static inline Cell * lambda_eval (Cell*, Cell**);
197 | static inline Cell * print_eval  (Cell*, Cell**);
198 | static Cell * eval (Cell*, Cell**);
199 | 
200 | static Cell * set_lambda_args (Cell * name_l_, Cell * v_l_, Cell ** env ) {
201 |   Cell * local_env = *env;
202 |   Cell * name_l;
203 |   Cell * v_l;
204 |   for (name_l = name_l_, v_l = v_l_; name_l!=Nil && v_l!=Nil; name_l = name_l->cdr_, v_l = v_l->cdr_) {
205 |     Cell * A       = make_cell(&(Cell){ TCONS, .car_=name_l->car_, .cdr_=eval(v_l,env) });
206 |     Cell * new_env = make_cell(&(Cell){ TCONS, .car_=A,            .cdr_=local_env });
207 |     local_env = new_env;
208 |   }
209 |   return local_env;
210 | }
211 | 
212 | #define primitive(n,s) \
213 |   do{if (strcmp(cell->symbol_,#s)==0) return n##_eval(args, env);}while(0)
214 | 
215 | static Cell * apply (Cell * cell, Cell * args, Cell ** env) {
216 |   switch(cell->type_){
217 |     case TSYMBOL:
218 |       primitive(plus,        +);
219 |       primitive(minus,       -);
220 |       primitive(time,        *);
221 |       primitive(divid,       /);
222 |       primitive(mod,       mod);
223 |       primitive(great,       >);
224 |       primitive(less,        <);
225 |       primitive(equal,       =);
226 |       primitive(and,       and);
227 |       primitive(or,         or);
228 |       primitive(if,         if);
229 |       primitive(car,       car);
230 |       primitive(cdr,       cdr);
231 |       primitive(list,     list);
232 |       primitive(def,    define);
233 |       primitive(lambda, lambda);
234 |       primitive(print,   print);
235 |       break;
236 |     case TFUN:{
237 |                 Cell * local_env = *env;
238 |                 local_env = set_lambda_args(cell->car_, args, env);
239 |                 return eval(cell->cdr_, &local_env);
240 |               }
241 |   }
242 |   return Nil;
243 | }
244 | 
245 | static Cell * find_symbol (Cell * cell, Cell ** env) {
246 |   for (Cell * E = *env; E != Nil; E = E->cdr_ ) {
247 |     if (strcmp(cell->symbol_,E->car_->symbol_)==0) {
248 |       return E->car_->cdr_;
249 |     }
250 |   }
251 |   return cell;
252 | }
253 | 
254 | static Cell * eval (Cell * cell, Cell ** env) {
255 |   switch(cell->type_){
256 |     case TUNIT: case TENV:
257 |       break;
258 |     case TNIL: case TTRUE: case TFALSE: case TINT: case TREAL: case TFUN: case TLIST:
259 |       return cell;
260 |     case TCONS:
261 |       return apply( eval(cell->car_,env), cell->car_->cdr_, env);
262 |     case TSYMBOL:
263 |       return find_symbol(cell, env);
264 |   }
265 |   return eval(cell->cdr_, env);
266 | }
267 | 
268 | // (+ _ ...)
269 | static inline Cell * plus_eval (Cell * cell, Cell ** env) {
270 |   int   result   = 0;
271 |   float result_r = 0;
272 |   int type;
273 |   Cell * Tp = eval(cell, env);
274 |   if (Tp->type_ == TINT)   // setting type && culc
275 |     result += Tp->int_;
276 |   else if (Tp->type_ == TREAL)
277 |     result_r += Tp->real_;
278 |   type = Tp->type_;
279 |   for (Cell * p = cell->cdr_; p != Nil; p = p->cdr_) { // culc
280 |     Cell * T = eval(p, env);
281 |     if (T->type_ == TINT && type == TINT)
282 |       result += T->int_;
283 |     else if (T->type_ == TREAL && type == TREAL)
284 |       result_r += T->real_;
285 |     else
286 |       perror("type error in '+'.");
287 |   }
288 |   if (type == TINT)
289 |     return cell_int(result);
290 |   else
291 |     return cell_real(result_r);
292 | }
293 | 
294 | // (- _ ...)
295 | static inline Cell * minus_eval (Cell * cell, Cell ** env) {
296 |   Cell * p = eval(cell,env);
297 |   int   result;
298 |   float result_r;
299 |   if (p->type_ == TINT) // check type
300 |     result = p->int_;
301 |   else if (p->type_ == TREAL)
302 |     result_r = p->real_;
303 |   int type = p->type_;
304 |   for (p = cell->cdr_; p != Nil; p = p->cdr_) { // culc
305 |     Cell * T = eval(p, env);
306 |     if (T->type_ == TINT && type == TINT)
307 |       result -= T->int_;
308 |     else if (T->type_ == TREAL && type == TREAL)
309 |       result_r -= T->real_;
310 |     else
311 |       perror("type error in '-'.");
312 |   }
313 |   if (type == TINT)
314 |     return cell_int(result);
315 |   else
316 |     return cell_real(result_r);
317 | }
318 | 
319 | // (* _ ...)
320 | static inline Cell * time_eval (Cell * cell, Cell ** env) {
321 |   int   result = 1;
322 |   float result_r = 1.0;
323 |   Cell * Tp = eval(cell, env);
324 |   if (Tp->type_ == TINT)
325 |     result *= Tp->int_;
326 |   else if (Tp->type_ == TREAL)
327 |     result_r *= Tp->real_;
328 |   int type = Tp->type_;
329 |   for (Cell * p = cell->cdr_; p != Nil; p = p->cdr_) {
330 |     Cell * T = eval(p, env);
331 |     if (T->type_ == TINT && type == TINT){
332 |       if (T->int_ != 0)
333 |         result *= T->int_;
334 |       else
335 |         return cell_int(0);
336 |     }
337 |     else if (T->type_ == TREAL && type == TREAL) {
338 |       if (T->real_ != 0)
339 |         result_r *= T->real_;
340 |       else
341 |         return cell_real(0);
342 |     }
343 |     else
344 |       perror("type error in '*'.");
345 |   }
346 |   if (type == TINT)
347 |     return cell_int(result);
348 |   else
349 |     return cell_real(result_r);
350 | }
351 | 
352 | // (/ _ ...)
353 | static inline Cell * divid_eval (Cell * cell, Cell ** env) {
354 |   Cell * p = eval(cell,env);
355 |   int type = p->type_;
356 |   int result;
357 |   float result_r;
358 |   if (type == TINT)
359 |     result = p->int_;
360 |   else if (type == TREAL)
361 |     result_r = p->real_;
362 |   for (p = cell->cdr_; p != Nil; p = p->cdr_){
363 |     Cell * T = eval(p,env);
364 |     if (T->type_ == TINT && type == TINT) {
365 |       if (T->int_ != 0)
366 |         result /= T->int_;
367 |       else{
368 |         perror("divided not have 0");
369 |       }
370 |     }else if (T->type_ == TREAL && type == TREAL) {
371 |       if (T->real_ != 0.0)
372 |         result_r /= T->real_;
373 |       else{
374 |         perror("divided not have 0");
375 |       }
376 |     }
377 |     else
378 |       printf("type error in '/'.");
379 |   }
380 |   if (type == TINT)
381 |     return cell_int(result);
382 |   else
383 |     return cell_real(result_r);
384 | }
385 | 
386 | static inline Cell * mod_eval (Cell * cell, Cell ** env) {
387 |   Cell * L = eval(cell,       env);
388 |   Cell * R = eval(cell->cdr_, env);
389 |   int type = L->type_;
390 |   if (type == TINT && R->type_ == TINT)
391 |     return cell_int(L->int_ % R->int_);
392 |   else
393 |     perror("type errpr in 'mod'.");
394 |   return Nil;
395 | }
396 | 
397 | // (> _ _)
398 | static inline Cell * great_eval (Cell * cell, Cell ** env) {
399 |   Cell * L = eval(cell,       env);
400 |   Cell * R = eval(cell->cdr_, env);
401 |   if (L->type_ == TINT && R->type_ == TINT)
402 |     return (L->int_ > R->int_) ? TRUE : FALSE;
403 |   else if (L->type_ == TREAL && R->type_ == TREAL)
404 |     return (L->real_ > R->real_) ? TRUE : FALSE;
405 |   perror("type error in '>'");
406 |   return Nil;
407 | }
408 | 
409 | // (< _ _)
410 | static inline Cell * less_eval (Cell * cell, Cell ** env) {
411 |   Cell * L = eval(cell,       env);
412 |   Cell * R = eval(cell->cdr_, env);
413 |   if (L->type_ == TINT && R->type_ == TINT)
414 |     return (L->int_ < R->int_) ? TRUE : FALSE;
415 |   else if (L->type_ == TREAL && R->type_ ==TREAL)
416 |     return (L->real_ < R->real_) ? TRUE : FALSE;
417 |   perror("type error in '<'");
418 |   return Nil;
419 | }
420 | 
421 | // (= _ _)
422 | static inline Cell * equal_eval (Cell * cell, Cell ** env) {
423 |   Cell * L = eval(cell,       env);
424 |   Cell * R = eval(cell->cdr_, env);
425 |   if (L->type_ == TINT && R->type_ == TINT)
426 |     return (L->int_ == R->int_) ? TRUE : FALSE;
427 |   else if (L->type_ == TREAL && R->type_ == TREAL)
428 |     return (L->real_ == R->real_) ? TRUE : FALSE;
429 |   printf("equal error\n");
430 |   return Nil;
431 | }
432 | 
433 | // (and _ ...)
434 | static inline Cell * and_eval (Cell * cell, Cell ** env) {
435 |   for (Cell * p = cell; p != Nil; p=p->cdr_) {
436 |     Cell * T = eval(p, env);
437 |     if (T == FALSE)
438 |       return FALSE;
439 |   }
440 |   return TRUE;
441 | }
442 | 
443 | // (or _ ...)
444 | static inline Cell * or_eval (Cell * cell, Cell ** env) {
445 |   for (Cell * p = cell; p != Nil; p=p->cdr_) {
446 |     Cell * T = eval(p, env);
447 |     if (T == TRUE)
448 |       return TRUE;
449 |   }
450 |   return FALSE;
451 | }
452 | 
453 | // (if _ _ _)
454 | static inline Cell * if_eval (Cell * cell, Cell ** env) {
455 |   Cell * p = eval(cell,env);
456 |   if (p == TRUE)  return eval (cell->cdr_, env);
457 |   if (p == FALSE) return eval (cell->cdr_->cdr_, env);
458 |   printf("if error\n");
459 |   return Nil;
460 | }
461 | 
462 | // (car _)
463 | static inline Cell * car_eval (Cell * cell, Cell ** env) {
464 |   return cell->car_;
465 | }
466 | 
467 | // (cdr _)
468 | static inline Cell * cdr_eval (Cell * cell, Cell ** env) {
469 |   return cell->car_->cdr_;
470 | }
471 | 
472 | // (lambda (_ ...) _)
473 | static inline Cell * lambda_eval (Cell * cell, Cell ** env) {
474 |   return make_cell(&(Cell){ TFUN, .car_=cell->car_, .cdr_=cell->cdr_ });
475 | }
476 | 
477 | // (list ...)
478 | static inline Cell * list_eval (Cell * cell, Cell ** env) {
479 |   Cell * r = eval(cell,env);
480 |   Cell * p = r;
481 |   for (Cell * t = cell->cdr_; t != Nil; t = t->cdr_) {
482 |     r->cdr_ = eval(t, env);
483 |     r = r->cdr_;
484 |   }
485 |   return cell_list(p);
486 | }
487 | 
488 | // (define _ _)
489 | static inline Cell * def_eval (Cell * cell, Cell ** env) {
490 |   Cell * new_env = NULL;
491 |   if (cell->type_ != TCONS) { // (define var body)
492 |     new_env = cell_cons(cell);
493 |     new_env->car_->cdr_ = eval(cell->cdr_, env);
494 |     new_env->cdr_ = *env;
495 |     *env = new_env;
496 |   } else { // (define (fname lvar) body)
497 |     Cell * fname = cell->car_;
498 |     Cell * lvars  = cell->car_->cdr_;
499 |     Cell * body  = cell->cdr_;
500 |     fname->cdr_ = make_cell(&(Cell){ TFUN, .car_=lvars, .cdr_=body });
501 |     new_env = cell_cons(fname);
502 |     new_env->cdr_ = *env;
503 |     *env = new_env;
504 |   }
505 |   return new_env;
506 | }
507 | 
508 | // (print _)
509 | static inline void print_eval_iter (Cell * cell, Cell ** env) {
510 |   switch(cell->type_) {
511 |     case TNIL:    printf("nil");                         break;
512 |     case TTRUE:   printf("#t");                          break;
513 |     case TFALSE:  printf("#f");                          break;
514 |     case TINT:    printf("%d", cell->int_);              break;
515 |     case TREAL:   printf("%f", cell->real_);             break;
516 |     case TFUN:    printf("lambda function");             break;
517 |     case TCONS:   print_eval_iter(eval(cell, env), env); break;
518 |     case TLIST: {
519 |                   printf("(");
520 |                   for (Cell * r = cell->car_; r != Nil; r = r->cdr_) {
521 |                     print_eval_iter(r, env);
522 |                     if (r->cdr_ != Nil) printf(" ");
523 |                   }
524 |                   printf(")");
525 |                   break;
526 |                 }
527 |     case TSYMBOL:
528 |                   print_eval_iter(find_symbol(cell, env), env);  break;
529 |     case TENV:
530 |                   printf("env");   break;
531 |     default:
532 |                   printf("print nothing");
533 |   }
534 | }
535 | static inline Cell * print_eval (Cell * cell, Cell ** env) {
536 |   print_eval_iter(cell, env);
537 |   printf("\n");
538 |   return make_cell(&(Cell){TUNIT});
539 | }
540 | /* ==== ==== ==== ==== ==== ==== ==== */
541 | 
542 | /* ==== ==== ==== main loop ==== ==== ==== */
543 | static void file_read_mode(char* argv[], Cell* E) {
544 |   fp = fopen(argv[1], "r");
545 |   Cell * R = parse();
546 |   do {
547 |     eval(R, &E);
548 |     R = R->cdr_;
549 |   } while( R != Nil );
550 | }
551 | 
552 | int main (int argc, char* argv[])
553 | {
554 |   Cell * E = Nil;
555 |   flag_list = 0;
556 | 
557 |   if (argc <= 1) {
558 |     perror("no input file.");
559 |     exit(1);
560 |   }
561 | 
562 |   if (argv[1]){
563 |     if (strcmp( ".scm" ,strstr(argv[1],".") ) != 0)
564 |       perror("file format is not .scm");
565 |     else {
566 |       file_read_mode(argv, E);
567 |    }
568 |   }
569 | 
570 |   return 0;
571 | }
572 | 


--------------------------------------------------------------------------------
/test.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/bash
 2 | 
 3 | function run() {
 4 | 	echo -n "$1 ... "
 5 | 	result=$(./bin/lisp "$1")
 6 | 	if [ "$result" != "$2" ]; then
 7 | 		echo FAILED
 8 | 		exit 1
 9 | 	fi
10 | 	echo ok
11 | }
12 | 
13 | run test/bool.scm "#f"
14 | run test/bool_real1.scm "#f"
15 | run test/bool_real2.scm "#t"
16 | run test/and.scm "#t"
17 | run test/or.scm "#t"
18 | run test/EuclideanAlgorithm.scm "31"
19 | run test/comment.scm "3"
20 | run test/cul.scm "-544"
21 | run test/define.scm "32"
22 | run test/define2.scm "12"
23 | run test/fact.scm "3628800"
24 | run test/fibonacci.scm "55"
25 | run test/fibonacci2.scm "55"
26 | run test/func.scm "3"
27 | run test/if.scm "0"
28 | run test/lambda.scm "6"
29 | run test/lambda2.scm "18"
30 | run test/list.scm "(1 2 3)"
31 | run test/lists.scm "((1 2) (2 3) (1 4))"
32 | run test/listfunc.scm "(1 2)"
33 | run test/mod.scm "0"
34 | run test/name.scm "6"
35 | run test/name_adv.scm "10"
36 | run test/neg.scm "98"
37 | run test/neg2.scm "1.000000"
38 | run test/neg_real.scm "-2.000000"
39 | run test/print.scm "1"
40 | run test/real_plus.scm "8.000000"
41 | run test/realtype.scm "3.141535"
42 | run test/real_minus.scm "-0.700000"
43 | run test/real_time.scm "1.860000"
44 | run test/real_dev.scm "1.500000"
45 | run test/recursion.scm "7"
46 | run test/newton.scm "2.236069"
47 | run test/ackermann.scm "13"
48 | 
49 | echo "All tests were done."
50 | 


--------------------------------------------------------------------------------
/test/EuclideanAlgorithm.scm:
--------------------------------------------------------------------------------
 1 | ;; 最大公約数
 2 | (define (my_gcd a b)
 3 |   (if (= (mod a b) 0)
 4 |     b (my_gcd b (mod a b))))
 5 | 
 6 | ;; 最小公倍数
 7 | (define (my_lcd a b)
 8 |   (/ (* b a) (my_gcd a b)))
 9 | 
10 | (print (/ (my_lcd 7 31) (my_gcd 35 21)))
11 | 


--------------------------------------------------------------------------------
/test/ackermann.scm:
--------------------------------------------------------------------------------
1 | (define (ackermann m n)
2 |   (if (= m 0) (+ n 1)
3 |     (if (= n 0) (ackermann (- m 1) 1)
4 |       (ackermann (- m 1) (ackermann m (- n 1))))))
5 | 
6 | 
7 | (print (ackermann 3 1))
8 | 


--------------------------------------------------------------------------------
/test/and.scm:
--------------------------------------------------------------------------------
1 | (print (and (> 2 1) (= 3 3)))
2 | 


--------------------------------------------------------------------------------
/test/bool.scm:
--------------------------------------------------------------------------------
1 | (print (> 1 2))
2 | 


--------------------------------------------------------------------------------
/test/bool_real1.scm:
--------------------------------------------------------------------------------
1 | (print (= 1.2 5.5))
2 | 


--------------------------------------------------------------------------------
/test/bool_real2.scm:
--------------------------------------------------------------------------------
1 | (print (> 101.2 0.00013))
2 | 


--------------------------------------------------------------------------------
/test/comment.scm:
--------------------------------------------------------------------------------
1 | ;; this is comment
2 | 
3 | (define (f a b)
4 |   ; Oh, its comment
5 |   (+ a b))
6 | 
7 | (print (f 1 2))
8 | 


--------------------------------------------------------------------------------
/test/cul.scm:
--------------------------------------------------------------------------------
1 | 
2 | (print (* 2 (+ 1 13 3) (/ 20 5) (- 1 2 3)))
3 | 
4 | 


--------------------------------------------------------------------------------
/test/define.scm:
--------------------------------------------------------------------------------
1 | (define x 32)
2 | (print x)
3 | 


--------------------------------------------------------------------------------
/test/define2.scm:
--------------------------------------------------------------------------------
1 | (define a (+ 3 3))
2 | 
3 | (print (+ a a))
4 | 


--------------------------------------------------------------------------------
/test/fact.scm:
--------------------------------------------------------------------------------
1 | (define (fact n)
2 |   (if (= n 0) 1 (* n (fact (- n 1)))))
3 | 
4 | (print (fact 10))
5 | 
6 | 


--------------------------------------------------------------------------------
/test/fibonacci.scm:
--------------------------------------------------------------------------------
1 | (define fib (lambda (n)
2 | 	      (if (< n 2) n
3 | 		(+ (fib (- n 1)) (fib (- n 2))))))
4 | 
5 | 
6 | (print (fib 10))
7 | 


--------------------------------------------------------------------------------
/test/fibonacci2.scm:
--------------------------------------------------------------------------------
1 | (define (fib n)
2 |   (if (< n 2) n
3 |     (+ (fib (- n 1)) 
4 | 		   (fib (- n 2)))))
5 | 
6 | 
7 | (print (fib 10))
8 | 


--------------------------------------------------------------------------------
/test/func.scm:
--------------------------------------------------------------------------------
1 | (define (f x y) (+ x y))
2 | 
3 | (print (f 1 2))
4 | 


--------------------------------------------------------------------------------
/test/if.scm:
--------------------------------------------------------------------------------
1 | (define x 1)
2 | (define y 2)
3 | 
4 | (print (if (> x y) 1 0))
5 | 


--------------------------------------------------------------------------------
/test/lambda.scm:
--------------------------------------------------------------------------------
1 | (print ((lambda (x) (+ x x)) 3))
2 | 


--------------------------------------------------------------------------------
/test/lambda2.scm:
--------------------------------------------------------------------------------
1 | (define f (lambda (x) (+ x x)))
2 | (define g (lambda (x y) (* x y)))
3 | 
4 | (define x (f 3))
5 | (define y (g 3 4))
6 | 
7 | (print (+ x y))
8 | 


--------------------------------------------------------------------------------
/test/list.scm:
--------------------------------------------------------------------------------
1 | (print '(1 2 3))
2 | 


--------------------------------------------------------------------------------
/test/listfunc.scm:
--------------------------------------------------------------------------------
1 | (print (list 1 2))
2 | 


--------------------------------------------------------------------------------
/test/lists.scm:
--------------------------------------------------------------------------------
1 | (print '((1 2) (2 3) (1 4)))
2 | 


--------------------------------------------------------------------------------
/test/mod.scm:
--------------------------------------------------------------------------------
1 | (print (mod 4 2))
2 | 


--------------------------------------------------------------------------------
/test/name.scm:
--------------------------------------------------------------------------------
1 | (define x2y (lambda (x) (+ x x)))
2 | 
3 | (define r3 (x2y 3))
4 | (print r3)
5 | 


--------------------------------------------------------------------------------
/test/name_adv.scm:
--------------------------------------------------------------------------------
 1 | (define f (lambda (a) (+ 1 a)))
 2 | 
 3 | (define g (lambda (a) (* 3 a)))
 4 | 
 5 | (define r1 (f (g 1)))
 6 | (define r2 (g (f 1)))
 7 | 
 8 | (print (+ r1 r2))
 9 | 
10 | 


--------------------------------------------------------------------------------
/test/neg.scm:
--------------------------------------------------------------------------------
1 | (define (neg a) (+ -1 a))
2 | 
3 | (print (+ -1 (neg 100)))
4 | 


--------------------------------------------------------------------------------
/test/neg2.scm:
--------------------------------------------------------------------------------
1 | (print 1.)
2 | 


--------------------------------------------------------------------------------
/test/neg_real.scm:
--------------------------------------------------------------------------------
1 | (print (+ 1.0 2.0 (- -3.9 1.1)))
2 | 


--------------------------------------------------------------------------------
/test/newton.scm:
--------------------------------------------------------------------------------
 1 | (define (abs a)
 2 |   (if (< a 0.0) (- 0.0 a) a))
 3 | 
 4 | (define (square x) (* x x))
 5 | 
 6 | (define (average a b)
 7 |   (/ (+ a b) 2.0))
 8 | 
 9 | (define (improve a b)
10 |   (average a (/ b a)))
11 | 
12 | (define (good? guess x)
13 |   (< (abs (- (square guess) x)) 0.00001))
14 | 
15 | (define (sqrt-iter guess x)
16 |   (if (good? guess x)
17 |     guess
18 |     (sqrt-iter (improve guess x)
19 | 	       x)))
20 | 
21 | (define (newton-sqrt n)
22 |   (sqrt-iter 1.0 n))
23 | 
24 | (print (newton-sqrt 5.0))
25 | 


--------------------------------------------------------------------------------
/test/or.scm:
--------------------------------------------------------------------------------
1 | (print (or (> 1 2) (= 3 2) (= 1 1)))
2 | 


--------------------------------------------------------------------------------
/test/print.scm:
--------------------------------------------------------------------------------
1 | (print 1)
2 | 


--------------------------------------------------------------------------------
/test/real_dev.scm:
--------------------------------------------------------------------------------
1 | (print (/ 3.0 2.0))
2 | 


--------------------------------------------------------------------------------
/test/real_minus.scm:
--------------------------------------------------------------------------------
1 | (print (- 3.6 4.3))
2 | 


--------------------------------------------------------------------------------
/test/real_plus.scm:
--------------------------------------------------------------------------------
1 | (print (+ 1.7 2.2 4.1))
2 | 


--------------------------------------------------------------------------------
/test/real_time.scm:
--------------------------------------------------------------------------------
1 | (print (* 3.1 0.6))
2 | 


--------------------------------------------------------------------------------
/test/realtype.scm:
--------------------------------------------------------------------------------
1 | (print 3.141535)
2 | 


--------------------------------------------------------------------------------
/test/recursion.scm:
--------------------------------------------------------------------------------
1 | (define f (lambda (x)
2 | 	    (if (= x 0) 1 (+ x (f (- x 1))))))
3 | 
4 | (define result (f 3))
5 | 
6 | (print result)
7 | 


--------------------------------------------------------------------------------