Fixed several bugs in the scheme translation layer

diff --git a/source/main.scm b/source/main.scm
index 799d697e230edf369003d823c297f5f9318fbe80..780254ce4eda7848748ad3aa973b4cc68b2a1273 100644 (file)
--- a/source/main.scm
+++ b/source/main.scm
@@ -14,11 +14,11 @@
   (define program (parse-file fname))
   (with-output-to-file ofname
     (lambda () (map print program)))
-  (load ofname))
+  (load ofname)
+  (delete-file ofname))
 
 ; If we have a file, then parse it
 (if (= 1 (length (command-line-arguments)))
   (interpret-file (car (command-line-arguments)))
-  ;(map print (parse-file (car (command-line-arguments))))
   (print "No input file provided."))
 

diff --git a/source/scheme.scm b/source/scheme.scm
index 7e0b2a7efec19dce3b902c5498a028db90284ee2..75ec5104758729a36f1f45cce61d0a8cc0803a23 100644 (file)
--- a/source/scheme.scm
+++ b/source/scheme.scm
@@ -1,4 +1,8 @@
-(declare (unit scheme) (uses parse-utils))
+(declare (unit scheme) (uses parse-utils extras))
+
+(define (obj->string obj)
+  (with-output-to-string
+    (lambda () (display obj))))
 
 (define (scheme-program lst)
   (if (null? lst) '()
@@ -26,7 +30,7 @@
   (syntree-text expr))
 
 (define (scheme-character expr)
-  (string-ref (syntree-text expr) 1))
+  (string-append "#\\" (string (string-ref (syntree-text expr) 1))))
 
 (define (scheme-number expr)
   (syntree-text expr))
@@ -40,17 +44,17 @@
 (define (scheme-define expr)
   (string-append
     "(define "
-    (scheme-expression (list-ref (syntree-children expr) 0))
+    (obj->string (scheme-expression (list-ref (syntree-children expr) 0)))
     " "
-    (scheme-expression (list-ref (syntree-children expr) 1))
+    (obj->string (scheme-expression (list-ref (syntree-children expr) 1)))
     ")"))
 
 (define (scheme-assign expr)
   (string-append
     "(set! "
-    (scheme-expression (list-ref (syntree-children expr) 0))
+    (obj->string (scheme-expression (list-ref (syntree-children expr) 0)))
     " "
-    (scheme-expression (list-ref (syntree-children expr) 1))
+    (obj->string (scheme-expression (list-ref (syntree-children expr) 1)))
     ")"))
 
 (define (scheme-if expr)
@@ -73,5 +77,7 @@
   (list (map scheme-expression (syntree-children expr))))
 
 (define (scheme-block expr)
-  (map scheme-expression (syntree-children expr)))
+  (if (null? (syntree-children expr))
+    '('())
+    (map scheme-expression (syntree-children expr))))
 

diff --git a/tests/test.scm b/tests/test.scm
index 8d1da87f3dc04473c144520485bdfbdcf449e72b..48629ba53dccbb29dc0ed236f6ed3dc985ae0cab 100644 (file)
--- a/tests/test.scm
+++ b/tests/test.scm
@@ -1,13 +1,10 @@
-(declare (unit test)
-         (compile-syntax))
+(declare (unit test))
 
 (define unit-tests '())
 
 (define (register-test! test)
   (set! unit-tests (append unit-tests (list test))))
 
-;(define (error msg) msg)
-
 (define (print-summary pass fail)
   (if (zero? fail)
     (print "Success: " pass " tests passed.")