aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTeddy <ted.sybil@gmail.com>2013-08-12 11:10:28 +0800
committerTeddy <ted.sybil@gmail.com>2013-08-12 11:10:28 +0800
commite46af8eff6fcaa1cf06a08dde28ad6ea201657e7 (patch)
treec7b4e06c71c8f1d4e4438364ffb4f0d36d5a8364
parentc5364249b2600f25155f4c7ac206b3d6ca0e5b06 (diff)
ready for alpha release
-rw-r--r--Makefile2
-rw-r--r--builtin.cpp2
-rw-r--r--main.cpp99
-rw-r--r--test/robust_test.scm90
4 files changed, 155 insertions, 38 deletions
diff --git a/Makefile b/Makefile
index 9b08a29..45795d8 100644
--- a/Makefile
+++ b/Makefile
@@ -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();
}
diff --git a/main.cpp b/main.cpp
index 28bd27d..e751dd3 100644
--- a/main.cpp
+++ b/main.cpp
@@ -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)