From: Chris Hanson Date: Thu, 1 Feb 2018 07:00:33 +0000 (-0800) Subject: Simplify how runtime syntactic environments are created. X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~281 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8ad474ab812c9cd8e8904eaff9b2282cd22c5c44;p=mit-scheme.git Simplify how runtime syntactic environments are created. No more layering of top-level environments over one another, or of top-level environments over runtime environments -- a top-level environment IS a runtime environment. --- diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index bb0033b74..7c04ffdea 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -4460,7 +4460,6 @@ USA. make-internal-syntactic-environment make-keyword-syntactic-environment make-partial-syntactic-environment - make-top-level-syntactic-environment syntactic-environment->environment syntactic-environment/bind-keyword syntactic-environment/bind-variable diff --git a/src/runtime/syntax-environment.scm b/src/runtime/syntax-environment.scm index 6f8b8567f..af5e5d873 100644 --- a/src/runtime/syntax-environment.scm +++ b/src/runtime/syntax-environment.scm @@ -41,7 +41,7 @@ USA. ((senv-get-type senv))) (define (syntactic-environment/top-level? senv) - (memq (senv-type senv) '(top-level runtime-top-level))) + (eq? 'top-level (senv-type senv))) (define (syntactic-environment->environment senv) ((senv-get-runtime senv))) @@ -68,76 +68,48 @@ USA. (define (->syntactic-environment object #!optional caller) (declare (ignore caller)) (cond ((syntactic-environment? object) object) - ((environment? object) (%make-runtime-syntactic-environment object)) + ((interpreter-environment? object) (%top-level-runtime-senv object)) + ((environment? object) (%internal-runtime-senv object)) (else (error "Unable to convert to a syntactic environment:" object)))) - + ;;; Runtime syntactic environments are wrappers around runtime environments. -;;; They maintain their own bindings, but can defer lookups of syntactic -;;; keywords to the given runtime environment. -(define (%make-runtime-syntactic-environment env) +(define (%internal-runtime-senv env) (define (get-type) - (if (interpreter-environment? env) 'runtime-top-level 'runtime)) + 'runtime) (define (get-runtime) env) (define (lookup identifier) - (and (symbol? identifier) - (environment-lookup-macro env identifier))) + (environment-lookup-macro env identifier)) (define (store identifier item) - (environment-define-macro env identifier item)) + (error "Can't bind in non-top-level runtime environment:" identifier item)) (define (rename identifier) - identifier) + (error "Can't rename in non-top-level runtime environment:" identifier)) (make-senv get-type get-runtime lookup store rename)) - -;;; Keyword environments are used to make keywords that represent items. - -(define (make-keyword-syntactic-environment name item) - - (define (get-type) - 'keyword) - - (define (get-runtime) - (error "Can't evaluate in keyword environment.")) - - (define (lookup identifier) - (and (eq? name identifier) - item)) - - (define (store identifier item) - (error "Can't bind in keyword environment:" identifier item)) - - (define (rename identifier) - (error "Can't rename in keyword environment:" identifier)) - - (guarantee raw-identifier? name 'make-keyword-environment) - (guarantee keyword-item? item 'make-keyword-environment) - (make-senv get-type get-runtime lookup store rename)) ;;; Top-level syntactic environments represent top-level environments. -;;; They are always layered over a runtime syntactic environment. +;;; They are always associated with a given runtime environment. -(define (make-top-level-syntactic-environment parent) - (guarantee syntactic-environment? parent - 'make-top-level-syntactic-environment) - (if (not (memq (senv-type parent) '(runtime-top-level top-level))) - (error:bad-range-argument parent 'make-top-level-syntactic-environment)) - (let ((bound '()) - (get-runtime (senv-get-runtime parent))) +(define (%top-level-runtime-senv env) + (let ((bound '())) (define (get-type) 'top-level) + (define (get-runtime) + env) + (define (lookup identifier) (let ((binding (assq identifier bound))) (if binding (cdr binding) - ((senv-lookup parent) identifier)))) + (environment-lookup-macro env identifier)))) (define (store identifier item) (let ((binding (assq identifier bound))) @@ -152,6 +124,30 @@ USA. (make-senv get-type get-runtime lookup store rename))) +;;; Keyword environments are used to make keywords that represent items. + +(define (make-keyword-syntactic-environment name item) + + (define (get-type) + 'keyword) + + (define (get-runtime) + (error "Can't evaluate in keyword environment.")) + + (define (lookup identifier) + (and (eq? name identifier) + item)) + + (define (store identifier item) + (error "Can't bind in keyword environment:" identifier item)) + + (define (rename identifier) + (error "Can't rename in keyword environment:" identifier)) + + (guarantee raw-identifier? name 'make-keyword-environment) + (guarantee keyword-item? item 'make-keyword-environment) + (make-senv get-type get-runtime lookup store rename)) + ;;; Internal syntactic environments represent environments created by ;;; procedure application. @@ -189,7 +185,7 @@ USA. unspecific))) (make-senv get-type get-runtime lookup store rename))) - + ;;; Partial syntactic environments are used to implement syntactic ;;; closures that have free names. diff --git a/src/runtime/syntax.scm b/src/runtime/syntax.scm index 2305828aa..5ca951cb1 100644 --- a/src/runtime/syntax.scm +++ b/src/runtime/syntax.scm @@ -52,8 +52,7 @@ USA. (with-identifier-renaming (lambda () (if (syntactic-environment/top-level? senv) - (compile-body-item/top-level - (classify/body forms (make-top-level-syntactic-environment senv))) + (compile-body-item/top-level (classify/body forms senv)) (output/sequence (compile/expressions forms senv))))))) (define (compile/expression expression environment)