Commit Scheme source files that are part of the compiler

Author: DemiMarie

lib/additions.scm

@@ -0,0 +1,4 @@
+(define (bound? sym) (symbol-bound? #f sym))
+(define aset! vector-set!)
+(define aref vector-ref)
+(define (atom? obj) (not (pair? obj)))

lib/bytecode.scm

@@ -175,8 +175,14 @@
            (emit bco 'load-nil)
            ;; Memoize the objects using the bytecode object's memo table
            (let ((index (hash-table-ref (memo bco) object (lambda () #f))))
-             (emit bco 'load-constant-index
-                   (if index index (add-to-constant-vector bco object))))))))
+             (emit bco
+                   'load-constant-index
+                   (if index
+                       index
+                       (begin
+                         (add-to-constant-vector bco object)
+                         (hash-table-set! (memo bco) object
+                                          (bco.consts-len bco))))))))))
 
   (define (emit-set! bco stack-position)
     (cond

lib/main.scm

@@ -6,39 +6,44 @@
    (environment)
    (bytecode)
    (assembler)
+   (only (guile) parameterize)
    (ice-9 pretty-print))
 
 (define (bound? sym) (symbol-bound? #f sym))
 (define aset! vector-set!)
 (define aref vector-ref)
 (define (atom? obj) (not (pair? obj)))
-
+(define bco (create-bco))
+(define env (env.new))
+(define (compile-one-form)
+  (let ((res (read)))
+    (if (eof-object? res)
+        (values)
+        (begin
+          (compile-form res env bco)
+          (compile-one-form)))))
+(let ((tmp-bco (create-bco))
+      (tmp-env (env.new)))
+  (emit-constant tmp-bco 'alpha)
+  (emit-constant tmp-bco 'alpha)
+  (assert (= 1 (bco.consts-len tmp-bco))))
+(define (compile-file filename)
+  (with-input-from-file filename compile-one-form))
 (define (main args)
-  (with-input-from-file (cadr args)
-    (lambda ()
-      (let ((list-to-build (cons #f '())))
-        (let cont ((env (env.new))
-                   (bco (create-bco))
-                   (last-compiled-head list-to-build))
-          (let ((res (read)))
-            (if (eof-object? res)
-                (cdr list-to-build)
-                (let-values (((_ just-compiled)
-                              (compile-form res env bco)))
-                  (let ((instrs
-                         (vector-copy (bco.instrs just-compiled)
-                                      0
-                                      (bco.len just-compiled)
-                                      #f)))
-                    (pretty-print
-                     `#(,instrs
-                        ,(vector-copy (bco.consts just-compiled)
-                                      0
-                                      (bco.consts-len just-compiled)
-                                      #f)))
-                    #;(pretty-print
-                     (assemble-bytecode
-                      (vector->list instrs)))
-                      (cont env bco (list just-compiled)))))))))))
-
+  (for-each compile-file (cdr args))
+  (let ((instrs
+         (vector-copy (bco.instrs bco)
+                      0
+                      (bco.len bco)
+                      #f)))
+    (pretty-print
+     `#(,instrs
+        ,(vector-copy (bco.consts bco)
+                      0
+                      (bco.consts-len bco)
+                      #f)))))
+    #;(pretty-print
+       (assemble-bytecode
+       (vector->list instrs)))
+(fluid-set! read-eval? #t)
 (pretty-print (main (command-line)))