diff options
| -rw-r--r-- | csc/compiler.csc | 89 | ||||
| -rw-r--r-- | csc/testing.csc | 10 |
2 files changed, 6 insertions, 93 deletions
diff --git a/csc/compiler.csc b/csc/compiler.csc deleted file mode 100644 index 5486344..0000000 --- a/csc/compiler.csc +++ /dev/null @@ -1,89 +0,0 @@ -(define-library (csc compiler) - (import (scheme base) - (only (csc hash-map) - hash-bytevector - insert - key-not-found-error? - lookup - make-map - map-for-each - merge) - (only (csc ir1) - toplevel-define?) - (only (csc loop) - loop - return) - (only (csc macros) - builtins-environment - expand) - (only (csc match) match)) - (begin - - - (define (hash-symbol s) - (hash-bytevector (string->utf8 (symbol->string s)))) - - - (define (cmp-symbol s1 s2) - (string<? (symbol->string s1) (symbol->string s2))) - - - (define-record-type <syntax-error> - (make-syntax-error msg irritants) - syntax-error?) - - - (define (raise-syntax-error msg . irritants) - (raise (make-syntax-error msg irritants))) - - - (define (parse-import-set expr) - (match expr - (((! 'only) import-set . idents) - (loop with bindings = (parse-import-set import-set) - and new-bindings = (make-map hash-symbol cmp-symbol) - for ident in idents - do (set! new-bindings - (insert new-bindings - ident - (guard (e ((key-not-found-error? e) (raise-syntax-error "unknown symbol in `only' form" ident))) - (lookup bindings ident)))) - finally (return new-bindings))) - ((! '(csc builtins)) - builtins-environment) - (_ (raise-syntax-error "unknown or unsupported import set form" expr)))) - - - - (define (parse-import expr) - (match expr - (((! 'import) . import-sets) - (loop with bindings = (make-map hash-symbol cmp-symbol) - for import-set in import-sets - do (set! bindings - (merge bindings (parse-import-set import-set))) - finally (return bindings))) - (_ (raise-syntax-error "expected import form" expr)))) - - - (define-record-type <program> - (make-program imports body) - program? - (imports program-imports) - (body program-body)) - - - ; A Scheme program consists of one or more import declarations - ; followed by a sequence of expressions and definitions. - ; -- R7RS - (define (program->ir1 program) - (loop with bindings = (make-map hash-symbol cmp-symbol) - for body on program - for expr = (car body) - do (match expr - (((! 'import) . import-sets) - (set! bindings - (merge bindings (parse-import expr)))) - (_ (loop for expr in body - for expanded-expr = (expand expr bindings) - if (toplevel-define? expanded-expr) diff --git a/csc/testing.csc b/csc/testing.csc index a0180e6..aad2a63 100644 --- a/csc/testing.csc +++ b/csc/testing.csc @@ -59,11 +59,13 @@ (define-syntax assert-equal (syntax-rules () + ((assert-equal cmp left right) + (let ((x left) + (y right)) + (unless (cmp x y) + (fatalf "Fatal: {} is not equal to {}.\nleft is {}\nright is {}" 'left 'right x y)))) ((assert-equal left right) - (let ((x left) - (y right)) - (unless (equal? x y) - (fatalf "Fatal: {} is not equal to {}.\nleft is {}\nright is {}" 'left 'right x y)))))) + (assert-equal equal? left right)))) (define-syntax assert-raises |