From 8d2d1d63f18a559dec96b15e23b2ae5398cd21c5 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
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