From d935033e13939e184aaab677ad492a5433f361a6 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 25 Jan 2018 20:05:28 -0800 Subject: [PATCH] Introduce syntactic-environment/reserve to handle common case. This also means that syntactic-environment/define is only used for keyword items. --- src/runtime/mit-syntax.scm | 11 +++-------- src/runtime/runtime.pkg | 1 + src/runtime/syntax-environment.scm | 16 +++++----------- 3 files changed, 9 insertions(+), 19 deletions(-) diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm index e508e0a72..ba8b33b2e 100644 --- a/src/runtime/mit-syntax.scm +++ b/src/runtime/mit-syntax.scm @@ -144,9 +144,7 @@ USA. (lambda (form environment) (let ((name (cadr form))) (if (not (syntactic-environment/top-level? environment)) - (syntactic-environment/define environment - name - (make-reserved-name-item))) + (syntactic-environment/reserve environment name)) (variable-binder environment name (classify/expression (caddr form) environment)))))) @@ -217,11 +215,8 @@ USA. (let ((bindings (cadr form)) (body (cddr form)) (binding-env (make-internal-syntactic-environment env))) - (for-each (let ((item (make-reserved-name-item))) - (lambda (binding) - (syntactic-environment/define binding-env - (car binding) - item))) + (for-each (lambda (binding) + (syntactic-environment/reserve binding-env (car binding))) bindings) ;; Classify right-hand sides first, in order to catch references to ;; reserved names. Then bind names prior to classifying body. diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 2f5c91754..a9341e35a 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -4471,6 +4471,7 @@ USA. syntactic-environment->environment syntactic-environment/define syntactic-environment/lookup + syntactic-environment/reserve syntactic-environment/top-level? syntactic-environment?)) diff --git a/src/runtime/syntax-environment.scm b/src/runtime/syntax-environment.scm index 827a55627..a56ec2b0d 100644 --- a/src/runtime/syntax-environment.scm +++ b/src/runtime/syntax-environment.scm @@ -51,21 +51,15 @@ USA. (guarantee identifier? identifier 'syntactic-environment/lookup) ((senv-lookup senv) identifier)) +(define (syntactic-environment/reserve senv identifier) + (guarantee identifier? identifier 'syntactic-environment/reserve) + ((senv-store senv) identifier (make-reserved-name-item))) + (define (syntactic-environment/define senv identifier item) (guarantee identifier? identifier 'syntactic-environment/define) - (guarantee senv-value-item? item 'syntactic-environment/define) + (guarantee keyword-item? item 'syntactic-environment/define) ((senv-store senv) identifier item)) -(define (senv-value-item? object) - (or (reserved-name-item? object) - (keyword-item? object) - (variable-item? object))) -(register-predicate! senv-value-item? 'syntactic-environment-value-item) - -(define (syntactic-environment/rename senv identifier) - (guarantee identifier? identifier 'syntactic-environment/rename) - ((senv-rename senv) identifier)) - (define (bind-variable! senv identifier) (guarantee identifier? identifier 'bind-variable!) (let ((rename ((senv-rename senv) identifier))) -- 2.25.1