Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

a simplest possible define works

  • Loading branch information...
commit b4b5ef0327b051a89f65ed5b9287b41f5c076aa1 1 parent 6ac2800
@mikea authored
Showing with 46 additions and 2 deletions.
  1. +5 −2 compile.scm
  2. +14 −0 lower-tests.scm
  3. +26 −0 lower.scm
  4. +1 −0  rakefile
View
7 compile.scm
@@ -1,4 +1,5 @@
(load "scheme-parser.scm")
+(load "lower.scm")
(require-extension srfi-13)
(define literal-var-num 0)
@@ -288,8 +289,10 @@
(define (read-and-compile)
(output-header)
- (let ((ee (read-list)))
- (let ((r (compile-list ee main-list initial-environment)))
+ (let* ((ee (read-list))
+ (lee (lower ee)))
+ (display (format "; ~a\n" lee))
+ (let ((r (compile-list lee main-list initial-environment)))
(display (format
"call %struct.Data* @display( %struct.Data* ~a ) \n"
r))))
View
14 lower-tests.scm
@@ -0,0 +1,14 @@
+(use test)
+(load "lower.scm")
+
+(test-group "primitve-expr"
+ (test "abc" (lower "abc"))
+ (test '(12) (lower '(12))))
+
+(test-group "define"
+ (test '((let ((x 5)) x))
+ (lower '((define x 5)
+ x))))
+
+
+(test-exit)
View
26 lower.scm
@@ -0,0 +1,26 @@
+;; A module which lowers R5RS scheme into the scheme, which
+;; is acceptable by compiler
+
+(define (lower-define e t)
+ (let ((var (cadr e))
+ (value (caddr e)))
+ `((let ((,var ,value))
+ ,@(lower t)))))
+
+(define (lower-expr e t)
+ (define (loop e t)
+ (if t
+ (cons e (lower t))
+ e))
+ (if (and (pair? e) (symbol? (car e)))
+ (case (car e)
+ ((define) (lower-define e t))
+ (else (loop e t)))
+ (loop e t)))
+
+(define (lower e)
+ (if (null? e)
+ e
+ (if (pair? e)
+ (lower-expr (car e) (cdr e))
+ (lower-expr e #f))))
View
1  rakefile
@@ -24,6 +24,7 @@ end
task :unit_test do
sh "csi -b parser-lib-tests.scm"
sh "csi -b scheme-parser-tests.scm"
+ sh "csi -b lower-tests.scm"
end
task :runtime => "runtime.bc"
Please sign in to comment.
Something went wrong with that request. Please try again.