From 38431b74b9d1fd80df963a3f3de817443c5b689a Mon Sep 17 00:00:00 2001 From: "Mike D. Lowis" Date: Mon, 23 Jul 2012 19:25:05 -0400 Subject: [PATCH] Fixed several bugs in the scheme translation layer --- source/main.scm | 4 ++-- source/scheme.scm | 20 +++++++++++++------- tests/test.scm | 5 +---- 3 files changed, 16 insertions(+), 13 deletions(-) diff --git a/source/main.scm b/source/main.scm index 799d697..780254c 100644 --- 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 7e0b2a7..75ec510 100644 --- 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 8d1da87..48629ba 100644 --- 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.") -- 2.52.0