diff options
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | builtin.cpp | 2 | ||||
| -rw-r--r-- | main.cpp | 99 | ||||
| -rw-r--r-- | test/robust_test.scm | 90 |
4 files changed, 155 insertions, 38 deletions
@@ -2,7 +2,7 @@ main: main.o parser.o builtin.o model.o eval.o exc.o consts.o types.o g++ -o main $^ -pg -lgmp .cpp.o: - g++ $< -c -g -pg -DGMP_SUPPORT -Wall + g++ $< -c -g -pg -DGMP_SUPPORT -Wall -O2 clean: rm -f *.o diff --git a/builtin.cpp b/builtin.cpp index 859d5e4..1096d7a 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -1355,6 +1355,6 @@ BUILTIN_PROC_DEF(vector_length) { BUILTIN_PROC_DEF(display) { ARGS_EXACTLY_ONE; - printf("%s\n", args->car->ext_repr().c_str()); + printf("%s", args->car->ext_repr().c_str()); return new UnspecObj(); } @@ -3,64 +3,91 @@ #include "parser.h" #include "eval.h" #include "exc.h" -#include <cstdio> -int main(int argc, char **argv) { - //freopen("in.scm", "r", stdin); - Tokenizor *tk = new Tokenizor(); - ASTGenerator *ast = new ASTGenerator(); - Evaluator *eval = new Evaluator(); +#include <cstdio> +#include <cstdlib> - bool interactive = false; - bool preload = false; - char *fname; +Tokenizor *tk = new Tokenizor(); +ASTGenerator *ast = new ASTGenerator(); +Evaluator *eval = new Evaluator(); - int rcnt = 0; - for (int i = 1; i < argc; i++) - if (strcmp(argv[i], "-i") == 0) - interactive = true; - else if (strcmp(argv[i], "-l") == 0 && i < argc - 1) +void load_file(const char *fname) { + FILE *f = fopen(fname, "r"); + if (!f) + { + printf("Can not open file: %s\n", fname); + exit(0); + } + tk->set_stream(f); + while (1) + { + try { - preload = true; - fname = argv[i + 1]; + Pair *tree = ast->absorb(tk); + if (!tree) break; + eval->run_expr(tree); } - - if (preload) - { - FILE *f = fopen(fname, "r"); - if (!f) + catch (GeneralError &e) { - printf("Can not open file: %s\n", fname); - return 0; + fprintf(stderr, "An error occured: %s\n", e.get_msg().c_str()); } - tk->set_stream(f); - while (1) + } +} + +void print_help(const char *cmd) { + fprintf(stderr, + "Sonsi: Stupid and Obvious Scheme Interpreter\n" + "Usage: %s OPTION ...\n" + "Evaluate Scheme code, interactively or from a script.\n\n" + " FILE \t\tload Scheme source code from FILE, and exit\n" + "The above switches stop argument processing\n\n" + " -l FILE \tload Scheme source code from FILE\n" + " -h display \tthis help and exit\n", cmd); + exit(0); +} + +int main(int argc, char **argv) { + + for (int i = 1; i < argc; i++) + { + if (*argv[i] == '-') // parsing options { - try + if (strcmp(argv[i], "-l") == 0) { - Pair *tree = ast->absorb(tk); - if (!tree) break; - eval->run_expr(tree)->ext_repr().c_str(); + if (i + 1 < argc) + load_file(argv[++i]); + else + { + puts("missing argument to `-l` switch"); + print_help(*argv); + } } - catch (GeneralError &e) + else if (strcmp(argv[i], "-h") == 0) + print_help(*argv); + else { - fprintf(stderr, "An error occured: %s\n", e.get_msg().c_str()); + printf("unrecognized switch `%s`\n", argv[i]); + print_help(*argv); } } - interactive = true; + else + { + load_file(argv[i]); + exit(0); + } } - tk->set_stream(stdin); + + int rcnt = 0; + tk->set_stream(stdin); // interactive mode while (1) { - if (interactive) fprintf(stderr, "Sonsi> "); try { Pair *tree = ast->absorb(tk); if (!tree) break; string output = eval->run_expr(tree)->ext_repr(); - if (interactive) - fprintf(stderr, "Ret> $%d = %s\n", rcnt++, output.c_str()); + fprintf(stderr, "Ret> $%d = %s\n", rcnt++, output.c_str()); } catch (GeneralError &e) { diff --git a/test/robust_test.scm b/test/robust_test.scm index 6dd4abf..30f24f2 100644 --- a/test/robust_test.scm +++ b/test/robust_test.scm @@ -229,3 +229,93 @@ src (list x) x (cons x x) + +(display "Test the eight queen puzzle: \n") +(define (shl bits) + (define len (vector-length bits)) + (define res (make-vector len)) + (define (copy i) + (if (= i (- len 1)) + #t + (and + (vector-set! res i + (vector-ref bits (+ i 1))) + (copy (+ i 1))))) + (copy 0) + (vector-set! res (- len 1) #f) + res) + +(define (shr bits) + (define len (vector-length bits)) + (define res (make-vector len)) + (define (copy i) + (if (= i (- len 1)) + #t + (and + (vector-set! res (+ i 1) + (vector-ref bits i)) + (copy (+ i 1))))) + (copy 0) + (vector-set! res 0 #f) + res) + +(define (empty-bits len) (make-vector len #f)) +(define vs vector-set!) +(define vr vector-ref) +(define res 0) +(define (queen n) + + (define (search l m r step) + (define (col-iter c) + (if (= c n) + #f + (and + (if (and (eq? (vr l c) #f) + (eq? (vr r c) #f) + (eq? (vr m c) #f)) + (and + (vs l c #t) + (vs m c #t) + (vs r c #t) + ((lambda () (search l m r (+ step 1)) #t)) + (vs l c #f) + (vs m c #f) + (vs r c #f)) + ) + (col-iter (+ c 1)) + ))) + (set! l (shl l)) + (set! r (shr r)) + (if (= step n) + (set! res (+ res 1)) + (col-iter 0))) + + (search (empty-bits n) + (empty-bits n) + (empty-bits n) + 0) + res) + +(display (queen 8)) + +(display "Test Bibonacci numbers: \n") +(define (f x) + (if (<= x 2) 1 (+ (f (- x 1)) (f (- x 2))))) +(f 1) +(f 2) +(f 3) +(f 4) +(f 5) + +(define (g n) + (define (f p1 p2 n) + (if (<= n 2) + p2 + (f p2 (+ p1 p2) (- n 1)))) + (f 1 1 n)) + +(define (all i n) + (if (= n i) + #f + (and (display (g i)) (display "\n") (all (+ i 1) n)))) +(all 1 100) |