From fe3da18e6f452566e13c6e73ba46e27d0b3a434a Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 7 Aug 2022 15:57:42 -0700
Subject: Add include-library-declarations.

---
 lib/csc/compiler.csc | 63 +++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 50 insertions(+), 13 deletions(-)

(limited to 'lib/csc/compiler.csc')

diff --git a/lib/csc/compiler.csc b/lib/csc/compiler.csc
index 7054f10..d18c373 100644
--- a/lib/csc/compiler.csc
+++ b/lib/csc/compiler.csc
@@ -3,6 +3,7 @@
     add-library-search-dirs
     compile)
   (import (scheme base)
+          (csc format)
           (only (scheme file)
             call-with-input-file
             file-exists?)
@@ -48,23 +49,47 @@
           (only (csc match)
             match)
           (only (csc strings)
-            join))
+            join
+            last-index))
   (begin
 
 
-    (define (normalize-library lib)
+    (define (dirname f)
+      (define i (last-index f "/"))
+      (if (negative? i)
+        "."
+        (substring f 0 i)))
+
+
+    (define (read-file f)
+      (call-with-input-file f
+        (lambda (p)
+          (loop for expr = (read p)
+                until (eof-object? expr)
+                collect expr))))
+
+
+    (define (normalize-library lib-file)
+      (define dir (dirname lib-file))
+      (define lib (call-with-input-file lib-file read))
       (match lib
         (('define-library name . declarations)
-          (loop for decl in declarations
+          (define decls
+            (loop for decl in declarations
+                  if (match decl (('include-library-declarations _) #t)
+                            (_ #f))
+                    append (read-file (sprintf "{}/{}" dir (cadr decl)))
+                  else collect decl))
+          (loop for decl in decls
                 if (match decl (('export . _) #t)
                                (_ #f))
-                  collect (cdr decl) into exports
+                  append (cdr decl) into exports
                 else if (match decl (('import . _) #t)
                                (_ #f))
-                  collect (cdr decl) into imports
+                  append (cdr decl) into imports
                 else if (match decl (('begin . _) #t)
                                (_ #f))
-                  collect (cdr decl) into body
+                  append (cdr decl) into body
                 else
                   do (error "unexpected form in normalize-library" decl)
                 finally (return (list 'define-library name
@@ -106,7 +131,12 @@
 
 
     (define (ir1->bytecode expr)
-      (ir2->ir3 (closure-convert (ir1->ir2 expr (lambda (x) *tail*)))))
+      (printf "ir1 =\n{}\n" expr)
+      (define c (closure-convert (ir1->ir2 expr (lambda (x) *tail*))))
+      (printf "ir2 =\n{}\n" c)
+      (define b (ir2->ir3 c))
+      (printf "ir3 =\n{}\n" b)
+      b)
 
 
     ; compile turns scheme code into bytecode.
@@ -119,16 +149,17 @@
                    (merge env (load-library import)))
               finally (return env)))
       (define library-code '())
-      (define (compile-library lib)
-        (match (normalize-library lib)
+      (define (compile-library lib-file)
+        (define lib (normalize-library lib-file))
+        (match lib
           (('define-library library-name
             ('export . exports)
             ('import . imports)
             ('begin . body))
 
+            (define env (make-import-map imports))
             (define expanded-body (expand-body library-name body env))
 
-            (define env (make-import-map imports))
             (let loop ((expr expanded-body))
               (match expr
                 ((% %library-define (% %library-ref name _) val)
@@ -152,12 +183,18 @@
           (_ (error "unexpected form in compile-library" lib))))
       (define (load-library lib)
         (match lib
+          (('only lib . symbols)
+            (define m (load-library lib))
+            (define m* (make-map compare-symbols))
+            (for-each (lambda (symb)
+                        (set! m* (insert m* symb (guard (e ((key-not-found-error? e) (error "symbol does not exist in library" symb)))
+                                                   (lookup m symb)))))
+              symbols)
+            m*)
           ('(csc builtins)
             builtins-environment)
           (_ (or (lookup library-symbols lib #f)
-                 (call-with-input-file (find-library lib)
-                   (lambda (f)
-                     (compile-library (read f))))))))
+                 (compile-library (find-library lib))))))
 
       (match program
         ((('import . imports1) ('import . imports2) . rest)
-- 
cgit v1.3.1