From a89d6c82e981fec7d6e4c975e083d2b9e04467ad Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Mon, 1 May 2023 07:56:42 -0700 Subject: Rewrite most of the compiler. This represents a major step back in terms of functionality, and amount of code. The latter I think constitutes a major win. Next steps are to reimplement syntax-rules, call/cc, and call-with-values. --- lib/csc/compiler.csc | 202 --------------------------------------------------- 1 file changed, 202 deletions(-) delete mode 100644 lib/csc/compiler.csc (limited to 'lib/csc/compiler.csc') diff --git a/lib/csc/compiler.csc b/lib/csc/compiler.csc deleted file mode 100644 index ee6ca0f..0000000 --- a/lib/csc/compiler.csc +++ /dev/null @@ -1,202 +0,0 @@ -(define-library (csc compiler) - (export - add-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 - library-ref-name) - (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 - last-index)) - (begin - - - (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) - (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)) - append (cdr decl) into exports - else if (match decl (('import . _) #t) - (_ #f)) - append (cdr decl) into imports - else if (match decl (('begin . _) #t) - (_ #f)) - append (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) - ((stringstring 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) - (define c (closure-convert (ir1->ir2 expr (lambda (x) *tail*)))) - (define b (ir2->ir3 c)) - b) - - - ; 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-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)) - - (let loop ((expr expanded-body)) - (match expr - ((% %library-define ref _) - (set! env (insert env (library-ref-name ref) ref))) - ((% %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 - (('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) - (compile-library (find-library lib)))))) - - (match program - ((('import . imports1) ('import . imports2) . rest) - (compile (cons (cons '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