From acc561366f3fe6ec0377103f52ef0f7e923711c9 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Mon, 1 Aug 2022 19:35:19 -0700
Subject: Modify the project structure.

Now the lib directory contains what will eventually end up on the
user's /usr/lib/csc. When I write make install, it will copy all of
the .csc files from lib into the destination lib directory. This means I
can start working on the standard library in lib/scheme.
---
 lib/csc/compiler.csc | 164 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 164 insertions(+)
 create mode 100644 lib/csc/compiler.csc

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

diff --git a/lib/csc/compiler.csc b/lib/csc/compiler.csc
new file mode 100644
index 0000000..20d5d37
--- /dev/null
+++ b/lib/csc/compiler.csc
@@ -0,0 +1,164 @@
+(define-library (csc compiler)
+  (export
+    *library-search-dirs*
+    compile)
+  (import (scheme base)
+          (only (scheme file)
+            call-with-input-file
+            file-exists?)
+          (only (scheme read)
+            read)
+          (only (csc codegen)
+            ir2->ir3)
+          (only (csc config)
+            *standard-library-dir*)
+          (only (csc cps)
+            closure-convert
+            ir1->ir2)
+          (only (csc encoding)
+            encode)
+          (only (csc format)
+            sprintf)
+          (only (csc hash-map)
+            compare-symbols
+            hash-bytevector
+            insert
+            key-not-found-error?
+            lookup
+            make-comparer
+            make-map
+            merge)
+          (only (csc ir1)
+            %define-syntax
+            %library-define
+            %library-ref
+            %sequence)
+          (only (csc ir2)
+            *tail*)
+          (only (csc linker)
+            link)
+          (only (csc list)
+            revappend)
+          (only (csc loop)
+            loop
+            return)
+          (only (csc macros)
+            builtins-environment
+            expand-body)
+          (only (csc match)
+            match)
+          (only (csc strings)
+            join))
+  (begin
+
+
+    (define (normalize-library lib)
+      (match lib
+        (('define-library name . declarations)
+          (loop for decl in declarations
+                if (match decl (('export . _) #t)
+                               (_ #f))
+                  collect (cdr decl) into exports
+                else if (match decl (('import . _) #t)
+                               (_ #f))
+                  collect (cdr decl) into imports
+                else if (match decl (('begin . _) #t)
+                               (_ #f))
+                  collect (cdr decl) into body
+                else
+                  do (error "unexpected form in normalize-library" decl)
+                finally (return (list 'define-library name
+                                      (cons 'export exports)
+                                      (cons 'import imports)
+                                      (cons 'begin body)))))
+        (_ (error "unexpected form in normalize-library" lib))))
+
+
+    (define compare-library-names
+      (make-comparer
+        (lambda (x)
+          (hash-bytevector (string->utf8 (sprintf "{}" x))))
+        (lambda (x y)
+          (cond
+            ((equal? x y) 0)
+            ((string<? (sprintf "{}" x) (sprintf "{}" y)) -1)
+            (else 1)))))
+
+
+    (define *library-search-dirs* '())
+
+
+    (define (find-library name)
+      (define library-roots (cons *standard-library-dir* *library-search-dirs*))
+      (loop for dir in library-roots
+            for file-path = (loop for part in name
+                                  collect (symbol->string part) into path
+                                  finally (return (sprintf "{}/{}.csc" dir (join "/" path))))
+            if (file-exists? file-path)
+              return file-path
+            else
+              collect file-path into bad-paths
+            finally (error "unable to find library" name bad-paths)))
+
+
+    (define (ir1->bytecode expr)
+      (ir2->ir3 (closure-convert (ir1->ir2 expr (lambda (x) *tail*)))))
+
+
+    ; compile turns scheme code into bytecode.
+    (define (compile program)
+      (define library-symbols (make-map compare-library-names))
+      (define (make-import-map imports)
+        (define env (make-map compare-symbols))
+        (loop for import in imports
+              do (set! env
+                   (merge env (load-library import)))
+              finally (return env)))
+      (define library-code '())
+      (define (compile-library lib)
+        (match (normalize-library lib)
+          (('define-library library-name
+            ('export . exports)
+            ('import . imports)
+            ('begin . body))
+
+            (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)
+                  (set! env (insert env name val)))
+                ((% %define-syntax name val)
+                  (set! env (insert env name val)))
+                ((% %sequence head tail)
+                  (loop head)
+                  (loop tail))))
+
+            (define exported-symbols (make-map compare-symbols))
+            (loop for sym in exports
+                  do (set! exported-symbols
+                       (insert exported-symbols sym
+                         (guard (e ((key-not-found-error? e) (error "exported symbol was not defined in the library" sym)))
+                            (lookup env sym)))))
+
+            (set! library-symbols (insert library-symbols library-name exported-symbols))
+            (set! library-code (cons (ir1->bytecode expanded-body) library-code))
+            exported-symbols)
+          (_ (error "unexpected form in compile-library" lib))))
+      (define (load-library lib)
+        (match lib
+          ('(csc builtins)
+            builtins-environment)
+          (_ (or (lookup library-symbols lib #f)
+                 (call-with-input-file (find-library lib)
+                   (lambda (f)
+                     (compile-library (read f))))))))
+
+      (match program
+        ((('import . imports1) ('import . imports2) . rest)
+          (compile (cons (list 'import (append imports1 imports2)) rest)))
+        ((('import . imports) . body)
+          (define compiled-body (ir1->bytecode (expand-body 'main body (make-import-map imports))))
+          (encode (link (revappend library-code (list compiled-body (list (list 'exit (list 'const 0))))))))
+        (_ (error "unexpected form in compile" program))))))
-- 
cgit v1.3.1