From 8d2d1d63f18a559dec96b15e23b2ae5398cd21c5 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 11 Feb 2018 21:09:55 -0800 Subject: [PATCH] Eliminate the remaining three compilers. --- src/runtime/mit-syntax.scm | 14 +++++++------- src/runtime/runtime.pkg | 8 ++++---- src/runtime/syntax-definitions.scm | 17 ++++++----------- src/runtime/syntax-items.scm | 8 ++++---- 4 files changed, 21 insertions(+), 26 deletions(-) diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm index b2c46eb96..a1890a4f6 100644 --- a/src/runtime/mit-syntax.scm +++ b/src/runtime/mit-syntax.scm @@ -59,13 +59,13 @@ USA. ;;;; Core primitives -(define (compiler:lambda form senv hist) +(define (classifier:lambda form senv hist) (syntax-check '(_ mit-bvl + form) form) (compile-lambda scode-lambda-name:unnamed (cadr form) form senv hist)) -(define (compiler:named-lambda form senv hist) +(define (classifier:named-lambda form senv hist) (syntax-check '(_ (identifier . mit-bvl) + form) form) (compile-lambda (identifier->symbol (caadr form)) (cdadr form) @@ -78,9 +78,9 @@ USA. (map-mit-lambda-list (lambda (identifier) (bind-variable identifier senv)) bvl))) - (output/lambda name - bvl - (compile-body-item (classify-body-cddr form senv hist)))))) + (lambda-item name + bvl + (lambda () (classify-body-cddr form senv hist)))))) (define (compile-body-item item) (output/body (compile-body-items (item->list item)))) @@ -126,9 +126,9 @@ USA. (else (syntax-error "Variable required in this context:" (cadr form)))))) -(define (compiler:delay form senv hist) +(define (classifier:delay form senv hist) (syntax-check '(_ expression) form) - (output/delay (compile-expr-item (classify-form-cadr form senv hist)))) + (delay-item (lambda () (classify-form-cadr form senv hist)))) ;;;; Definitions diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 3273ca89a..8ba7bb7a5 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -4581,20 +4581,20 @@ USA. classifier:begin classifier:declare classifier:define-syntax + classifier:delay classifier:er-macro-transformer classifier:if + classifier:lambda classifier:let-syntax classifier:letrec-syntax + classifier:named-lambda classifier:or classifier:quote classifier:quote-identifier classifier:rsc-macro-transformer classifier:sc-macro-transformer classifier:set! - classifier:the-environment - compiler:delay - compiler:lambda - compiler:named-lambda) + classifier:the-environment) (export (runtime mit-macros) keyword:access keyword:define diff --git a/src/runtime/syntax-definitions.scm b/src/runtime/syntax-definitions.scm index 9b9147b93..cf8966a3b 100644 --- a/src/runtime/syntax-definitions.scm +++ b/src/runtime/syntax-definitions.scm @@ -32,11 +32,10 @@ USA. (add-boot-init! (lambda () - (define (def name item) - (environment-define-macro system-global-environment name item)) - (define (define-classifier name classifier) - (def name (classifier-item classifier))) + (environment-define-macro system-global-environment + name + (classifier-item classifier))) (define-classifier 'begin classifier:begin) (define-classifier 'declare classifier:declare) @@ -52,10 +51,6 @@ USA. (define-classifier 'sc-macro-transformer classifier:sc-macro-transformer) (define-classifier 'set! classifier:set!) (define-classifier 'the-environment classifier:the-environment) - - (define (define-compiler name compiler) - (def name (compiler-item compiler))) - - (define-compiler 'delay compiler:delay) - (define-compiler 'lambda compiler:lambda) - (define-compiler 'named-lambda compiler:named-lambda))) \ No newline at end of file + (define-classifier 'delay classifier:delay) + (define-classifier 'lambda classifier:lambda) + (define-classifier 'named-lambda classifier:named-lambda))) \ No newline at end of file diff --git a/src/runtime/syntax-items.scm b/src/runtime/syntax-items.scm index b2bb81db8..23cd6170f 100644 --- a/src/runtime/syntax-items.scm +++ b/src/runtime/syntax-items.scm @@ -172,10 +172,10 @@ USA. (lambda () (output/constant datum)))) -(define (lambda-item name bvl body-item) +(define (lambda-item name bvl classify-body) (expr-item (lambda () - (output/lambda name bvl (compile-expr-item body-item))))) + (output/lambda name bvl (compile-expr-item (classify-body)))))) (define (let-item names value-items body-item) (expr-item @@ -213,10 +213,10 @@ USA. (compile-expr-item env-item) (compile-expr-item rhs-item))))) -(define (delay-item item) +(define (delay-item classify) (expr-item (lambda () - (output/delay (compile-expr-item item))))) + (output/delay (compile-expr-item (classify)))))) (define (or-item items) (expr-item -- 2.25.1