ready for alpha release

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)