From 5857672bf5d5ec5a20caf42c7d15263e1b6cc79e Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Thu, 28 Jul 2022 15:42:26 -0700
Subject: Add the compiler frontend.

I haven't written any tests yet, so this code probably doesn't
even compile.
---
 csc/compiler.csc | 135 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 csc/config.csc   |   7 +++
 2 files changed, 142 insertions(+)
 create mode 100644 csc/compiler.csc
 create mode 100644 csc/config.csc

(limited to 'csc')

diff --git a/csc/compiler.csc b/csc/compiler.csc
new file mode 100644
index 0000000..4f1cafc
--- /dev/null
+++ b/csc/compiler.csc
@@ -0,0 +1,135 @@
+(define-library (csc compiler)
+  (export
+    *library-search-dir*
+    compile)
+  (import (scheme base)
+          (only (csc codegen)
+            ir2->ir3)
+          (only (csc config)
+            *standard-library-dir*)
+          (only (csc cps)
+            closure-convert
+            ir1->ir2)
+          (only (csc format)
+            sprintf)
+          (only (csc hash-map)
+            hash-bytevector
+            make-comparer
+            make-map
+            merge)
+          (only (csc linker)
+            link)
+          (only (csc list)
+            revappend)
+          (only (csc match)
+            match)
+          (only (scheme file)
+            file-exists?))
+  (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-dir* #f)
+
+
+    (define (find-library name)
+      (define library-roots (list *standard-library-dir*))
+      (when *library-search-dir*
+        (set! library-roots (cons *library-search-dir* library-roots)))
+      (loop for dir in library-roots
+            for file-path = (loop for part in name
+                                  collect (symbol->string part) into path
+                                  finally (return (join "/" (cons dir 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))))
+
+
+    ; 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
+                     (or (lookup library-symbols import #f)
+                         (call-with-input-file (find-library import)
+                           (lambda (f)
+                             (compile-library (read f)))))))
+              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 env (make-import-map imports))
+            (let loop ((expr (expand-body library-name body env)))
+              (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)))
+          (_ (error "unexpected form in compile-library" lib))))
+
+      (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))))
+          (link (revappend library-code (list compiled-body)))
+        (_ (error "unexpected form in compile" program))))))
diff --git a/csc/config.csc b/csc/config.csc
new file mode 100644
index 0000000..39268c0
--- /dev/null
+++ b/csc/config.csc
@@ -0,0 +1,7 @@
+(define-library (csc config)
+  (export *library-search-dir*)
+  (import (scheme base))
+  (begin
+
+
+    (define *standard-library-dir* "/usr/lib/csc")))
-- 
cgit v1.3.1