From f73404116afce798ca568c7d37a96a3b31b6d3c6 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 29 Jan 2018 21:08:54 -0800 Subject: [PATCH] A large number of renames for syntax items. --- src/edwin/clsmac.scm | 2 +- src/edwin/edwin.pkg | 2 +- src/runtime/host-adapter.scm | 31 ++++---- src/runtime/mit-syntax.scm | 34 ++++----- src/runtime/runtime.pkg | 54 +++++++------- src/runtime/syntax-classify.scm | 27 ++++--- src/runtime/syntax-compile.scm | 40 +++++----- src/runtime/syntax-definitions.scm | 4 +- src/runtime/syntax-environment.scm | 4 +- src/runtime/syntax-items.scm | 115 ++++++++++++++--------------- src/runtime/syntax-transforms.scm | 6 +- src/runtime/syntax.scm | 14 ++-- 12 files changed, 168 insertions(+), 165 deletions(-) diff --git a/src/edwin/clsmac.scm b/src/edwin/clsmac.scm index df8efc09b..cb60369fe 100644 --- a/src/edwin/clsmac.scm +++ b/src/edwin/clsmac.scm @@ -86,7 +86,7 @@ USA. (define with-instance-variables (make-unmapped-macro-reference-trap - (make-compiler-item + (compiler-item (lambda (form environment) (syntax-check '(KEYWORD IDENTIFIER EXPRESSION (* IDENTIFIER) + EXPRESSION) form) diff --git a/src/edwin/edwin.pkg b/src/edwin/edwin.pkg index 1de7fc0e4..c9c9a5742 100644 --- a/src/edwin/edwin.pkg +++ b/src/edwin/edwin.pkg @@ -287,7 +287,7 @@ USA. with-instance-variables) (import (runtime syntax) compile/expression - make-compiler-item)) + compiler-item)) (define-package (edwin class-macros transform-instance-variables) (files "xform") diff --git a/src/runtime/host-adapter.scm b/src/runtime/host-adapter.scm index 85d83b381..839bd4086 100644 --- a/src/runtime/host-adapter.scm +++ b/src/runtime/host-adapter.scm @@ -40,11 +40,11 @@ USA. (define (unbound? env name) (eq? 'unbound (environment-reference-type env name))) - (let ((env (->environment '()))) + (define (provide-rename env old-name new-name) + (if (unbound? env new-name) + (eval `(define ,new-name ,old-name) env))) - (define (provide-rename new-name old-name) - (if (unbound? env new-name) - (eval `(define ,new-name ,old-name) env))) + (let ((env (->environment '()))) (if (unbound? env 'guarantee) (eval `(define (guarantee predicate object #!optional caller) @@ -68,11 +68,11 @@ USA. object) env)) - (provide-rename 'random-bytevector 'random-byte-vector) - (provide-rename 'string-foldcase 'string-downcase) + (provide-rename env 'random-byte-vector 'random-bytevector) + (provide-rename env 'string-downcase 'string-foldcase) (for-each (lambda (old-name) - (provide-rename (symbol 'scode- old-name) old-name)) + (provide-rename env old-name (symbol 'scode- old-name))) '(access-environment access-name access? @@ -119,8 +119,9 @@ USA. variable-name variable?)) (for-each (lambda (root) - (provide-rename (symbol 'make-scode- root) - (symbol 'make- root))) + (provide-rename env + (symbol 'make- root) + (symbol 'make-scode- root))) '(access assignment combination @@ -137,9 +138,10 @@ USA. the-environment unassigned? variable)) - (provide-rename 'set-scode-lambda-body! 'set-lambda-body!) - (provide-rename 'undefined-scode-conditional-branch - 'undefined-conditional-branch)) + (provide-rename env 'set-lambda-body! 'set-scode-lambda-body!) + (provide-rename env + 'undefined-conditional-branch + 'undefined-scode-conditional-branch)) (let ((env (->environment '(runtime)))) (if (unbound? env 'select-on-bytes-per-word) @@ -147,7 +149,7 @@ USA. (er-macro-transformer (lambda (form rename compare) rename compare - (syntax-check '(KEYWORD EXPRESSION EXPRESSION) form) + (syntax-check '(keyword expression expression) form) (let ((bpo (bytes-per-object))) (case bpo ((4) (cadr form)) @@ -180,6 +182,9 @@ USA. (link-variables system-global-environment 'microcode-type env 'microcode-type)))) + (let ((env (->environment '(runtime syntax)))) + (provide-rename env 'make-compiler-item 'compiler-item)) + (let ((env (->environment '(package)))) (if (eval '(not (link-description? '#(name1 (package name) name2 #f))) env) diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm index c104c3516..a27ec554c 100644 --- a/src/runtime/mit-syntax.scm +++ b/src/runtime/mit-syntax.scm @@ -35,11 +35,11 @@ USA. (lambda (form environment) (syntax-check '(KEYWORD EXPRESSION) form) (let ((item (classify/expression (cadr form) environment))) - (make-keyword-value-item + (keyword-value-item (transformer->expander (transformer-eval (compile-item/expression item) environment) environment) - (make-expression-item + (expr-item (lambda () (output/combination (output/runtime-reference name) (list (compile-item/expression item) @@ -86,8 +86,8 @@ USA. (classify/body body environment)))))) (define (compile-body-item item) - (receive (declaration-items items) (extract-declarations-from-body item) - (output/body (map declaration-item/text declaration-items) + (receive (decl-items items) (extract-declarations-from-body item) + (output/body (map decl-item-text decl-items) (compile-body-items items)))) (define (classifier:begin form environment) @@ -111,9 +111,9 @@ USA. (define (compiler:quote-identifier form environment) (syntax-check '(keyword identifier) form) (let ((item (lookup-identifier (cadr form) environment))) - (if (not (variable-item? item)) + (if (not (var-item? item)) (syntax-error "Can't quote a keyword identifier:" form)) - (output/quoted-identifier (variable-item/name item)))) + (output/quoted-identifier (var-item-id item)))) (define (compiler:set! form environment) (syntax-check '(KEYWORD FORM ? EXPRESSION) form) @@ -132,8 +132,8 @@ USA. (define (classify/location form environment) (let ((item (classify/expression form environment))) - (cond ((variable-item? item) - (values (variable-item/name item) #f)) + (cond ((var-item? item) + (values (var-item-id item) #f)) ((access-item? item) (values (access-item/name item) (access-item/environment item))) (else @@ -150,7 +150,7 @@ USA. (lambda (form environment) (let ((name (cadr form))) (reserve-identifier environment name) - (variable-binder make-binding-item + (variable-binder defn-item environment name (classify/expression (caddr form) environment)))))) @@ -163,8 +163,8 @@ USA. ;; User-defined macros at top level are preserved in the output. (if (and (keyword-value-item? item) (syntactic-environment/top-level? environment)) - (make-binding-item name item) - (make-body-item '())))) + (defn-item name item) + (seq-item '())))) (define (keyword-binder environment name item) (if (not (keyword-item? item)) @@ -191,17 +191,17 @@ USA. (car binding) (classify/expression (cadr binding) env))) bindings))) - (make-expression-item + (expr-item (let ((names (map car bindings)) (values (map cdr bindings)) - (body-item + (seq-item (classify/body body (make-internal-syntactic-environment binding-env)))) (lambda () (output/let names (map compile-item/expression values) - (compile-body-item body-item)))))))))) + (compile-body-item seq-item)))))))))) (define (classifier:let-syntax form env) (syntax-check '(keyword (* (identifier expression)) + form) form) @@ -292,7 +292,7 @@ USA. (define (classifier:declare form environment) (syntax-check '(KEYWORD * (IDENTIFIER * DATUM)) form) - (make-declaration-item + (decl-item (lambda () (classify/declarations (cdr form) environment)))) @@ -303,13 +303,13 @@ USA. (define (classify/declaration declaration environment) (map-declaration-identifiers (lambda (identifier) - (variable-item/name + (var-item-id (classify/variable-reference identifier environment))) declaration)) (define (classify/variable-reference identifier environment) (let ((item (classify/expression identifier environment))) - (if (not (variable-item? item)) + (if (not (var-item? item)) (syntax-error "Variable required in this context:" identifier)) item)) \ No newline at end of file diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index f4a41bca7..565e2cf81 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -4415,41 +4415,41 @@ USA. (files "syntax-items") (parent (runtime syntax)) (export (runtime syntax) - binding-item/name - binding-item/value - binding-item? - body-item/components - body-item? - classifier-item/classifier + classifier-item + classifier-item-impl classifier-item? - compiler-item/compiler + compiler-item + compiler-item-impl compiler-item? - declaration-item/text - declaration-item? - expander-item/expander + decl-item + decl-item-text + decl-item? + defn-item + defn-item-id + defn-item-value + defn-item? + expander-item + expander-item-impl expander-item? - expression-item/compiler - expression-item? + expr-item + expr-item-compiler + expr-item? extract-declarations-from-body - flatten-body-items + flatten-seq-items item->list keyword-item? - keyword-value-item/expression - keyword-value-item/item + keyword-value-item + keyword-value-item-expr + keyword-value-item-keyword keyword-value-item? - make-binding-item - make-body-item - make-classifier-item - make-compiler-item - make-declaration-item - make-expander-item - make-expression-item - make-keyword-value-item - make-reserved-name-item - make-variable-item + reserved-name-item reserved-name-item? - variable-item/name - variable-item?)) + seq-item + seq-item-elements + seq-item? + var-item + var-item-id + var-item?)) (define-package (runtime syntax environment) (files "syntax-environment") diff --git a/src/runtime/syntax-classify.scm b/src/runtime/syntax-classify.scm index 47204699e..047907b21 100644 --- a/src/runtime/syntax-classify.scm +++ b/src/runtime/syntax-classify.scm @@ -32,9 +32,9 @@ USA. (cond ((identifier? form) (let ((item (lookup-identifier form environment))) (if (keyword-item? item) - (make-keyword-value-item + (keyword-value-item (strip-keyword-value-item item) - (make-expression-item + (expr-item (let ((name (identifier->symbol form))) (lambda () (output/combination @@ -53,31 +53,30 @@ USA. (strip-keyword-value-item (classify/expression (car form) environment)))) (cond ((classifier-item? item) - ((classifier-item/classifier item) form environment)) + ((classifier-item-impl item) form environment)) ((compiler-item? item) - (make-expression-item - (let ((compiler (compiler-item/compiler item))) + (expr-item + (let ((compiler (compiler-item-impl item))) (lambda () (compiler form environment))))) ((expander-item? item) - (classify/form ((expander-item/expander item) form - environment) + (classify/form ((expander-item-impl item) form environment) environment)) (else (if (not (list? (cdr form))) (syntax-error "Combination must be a proper list:" form)) - (make-expression-item + (expr-item (let ((items (classify/expressions (cdr form) environment))) (lambda () (output/combination (compile-item/expression item) (map compile-item/expression items))))))))) (else - (make-expression-item (lambda () (output/constant form)))))) + (expr-item (lambda () (output/constant form)))))) (define (strip-keyword-value-item item) (if (keyword-value-item? item) - (keyword-value-item/item item) + (keyword-value-item-keyword item) item)) (define (classify/expression expression environment) @@ -91,10 +90,10 @@ USA. (define (classify/body forms environment) ;; Syntactic definitions affect all forms that appear after them, so classify ;; FORMS in order. - (make-body-item - (let loop ((forms forms) (body-items '())) + (seq-item + (let loop ((forms forms) (items '())) (if (pair? forms) (loop (cdr forms) (reverse* (item->list (classify/form (car forms) environment)) - body-items)) - (reverse! body-items))))) \ No newline at end of file + items)) + (reverse! items))))) \ No newline at end of file diff --git a/src/runtime/syntax-compile.scm b/src/runtime/syntax-compile.scm index 9492bbb14..8085a3dca 100644 --- a/src/runtime/syntax-compile.scm +++ b/src/runtime/syntax-compile.scm @@ -29,36 +29,36 @@ USA. (declare (usual-integrations)) (define (compile-item/top-level item) - (if (binding-item? item) - (let ((name (identifier->symbol (binding-item/name item))) - (value (binding-item/value item))) + (if (defn-item? item) + (let ((name (identifier->symbol (defn-item-id item))) + (value (defn-item-value item))) (if (keyword-value-item? value) (output/top-level-syntax-definition name - (compile-item/expression (keyword-value-item/expression value))) + (compile-item/expression (keyword-value-item-expr value))) (output/top-level-definition name (compile-item/expression value)))) (compile-item/expression item))) -(define (compile-body-item/top-level body-item) - (receive (declaration-items body-items) - (extract-declarations-from-body body-item) - (output/top-level-sequence (map declaration-item/text declaration-items) +(define (compile-body-item/top-level seq-item) + (receive (decl-items body-items) + (extract-declarations-from-body seq-item) + (output/top-level-sequence (map decl-item-text decl-items) (map compile-item/top-level body-items)))) (define (compile-body-items items) - (let ((items (flatten-body-items items))) + (let ((items (flatten-seq-items items))) (if (not (pair? items)) (syntax-error "Empty body")) (output/sequence (append-map (lambda (item) - (if (binding-item? item) - (let ((value (binding-item/value item))) + (if (defn-item? item) + (let ((value (defn-item-value item))) (if (keyword-value-item? value) '() - (list (output/definition (binding-item/name item) + (list (output/definition (defn-item-id item) (compile-item/expression value))))) (list (compile-item/expression item)))) items)))) @@ -77,17 +77,17 @@ USA. (list predicate) compiler)))) -(define-item-compiler variable-item? +(define-item-compiler var-item? (lambda (item) - (output/variable (variable-item/name item)))) + (output/variable (var-item-id item)))) -(define-item-compiler expression-item? +(define-item-compiler expr-item? (lambda (item) - ((expression-item/compiler item)))) + ((expr-item-compiler item)))) -(define-item-compiler body-item? +(define-item-compiler seq-item? (lambda (item) - (compile-body-items (body-item/components item)))) + (compile-body-items (seq-item-elements item)))) (define (illegal-expression-compiler description) (lambda (item) @@ -100,8 +100,8 @@ USA. (define-item-compiler keyword-item? (illegal-expression-compiler "Syntactic keyword")) -(define-item-compiler declaration-item? +(define-item-compiler decl-item? (illegal-expression-compiler "Declaration")) -(define-item-compiler binding-item? +(define-item-compiler defn-item? (illegal-expression-compiler "Definition")) \ No newline at end of file diff --git a/src/runtime/syntax-definitions.scm b/src/runtime/syntax-definitions.scm index a45af37e5..8631e26e4 100644 --- a/src/runtime/syntax-definitions.scm +++ b/src/runtime/syntax-definitions.scm @@ -38,7 +38,7 @@ USA. (bind-keyword senv name item)) (define (define-classifier name classifier) - (def name (make-classifier-item classifier))) + (def name (classifier-item classifier))) (define-classifier 'BEGIN classifier:begin) (define-classifier 'DECLARE classifier:declare) @@ -50,7 +50,7 @@ USA. (define-classifier 'SC-MACRO-TRANSFORMER classifier:sc-macro-transformer) (define (define-compiler name compiler) - (def name (make-compiler-item compiler))) + (def name (compiler-item compiler))) (define-compiler 'DELAY compiler:delay) (define-compiler 'IF compiler:if) diff --git a/src/runtime/syntax-environment.scm b/src/runtime/syntax-environment.scm index bd32effba..6f8b8567f 100644 --- a/src/runtime/syntax-environment.scm +++ b/src/runtime/syntax-environment.scm @@ -52,7 +52,7 @@ USA. (define (syntactic-environment/reserve senv identifier) (guarantee raw-identifier? identifier 'syntactic-environment/reserve) - ((senv-store senv) identifier (make-reserved-name-item))) + ((senv-store senv) identifier (reserved-name-item))) (define (syntactic-environment/bind-keyword senv identifier item) (guarantee raw-identifier? identifier 'syntactic-environment/bind-keyword) @@ -62,7 +62,7 @@ USA. (define (syntactic-environment/bind-variable senv identifier) (guarantee raw-identifier? identifier 'syntactic-environment/bind-variable) (let ((rename ((senv-rename senv) identifier))) - ((senv-store senv) identifier (make-variable-item rename)) + ((senv-store senv) identifier (var-item rename)) rename)) (define (->syntactic-environment object #!optional caller) diff --git a/src/runtime/syntax-items.scm b/src/runtime/syntax-items.scm index 20648205f..4c571ac8e 100644 --- a/src/runtime/syntax-items.scm +++ b/src/runtime/syntax-items.scm @@ -34,25 +34,25 @@ USA. ;;; of keyword item. (define-record-type - (make-classifier-item classifier) + (classifier-item impl) classifier-item? - (classifier classifier-item/classifier)) + (impl classifier-item-impl)) (define-record-type - (make-compiler-item compiler) + (compiler-item impl) compiler-item? - (compiler compiler-item/compiler)) + (impl compiler-item-impl)) (define-record-type - (make-expander-item expander) + (expander-item impl) expander-item? - (expander expander-item/expander)) + (impl expander-item-impl)) (define-record-type - (make-keyword-value-item item expression) + (keyword-value-item keyword expr) keyword-value-item? - (item keyword-value-item/item) - (expression keyword-value-item/expression)) + (keyword keyword-value-item-keyword) + (expr keyword-value-item-expr)) (define (keyword-item? object) (or (classifier-item? object) @@ -68,19 +68,19 @@ USA. ;;; Variable items represent run-time variables. -(define (make-variable-item name) - (guarantee identifier? name 'make-variable-item) - (%make-variable-item name)) +(define (var-item id) + (guarantee identifier? id 'var-item) + (%var-item id)) -(define-record-type - (%make-variable-item name) - variable-item? - (name variable-item/name)) +(define-record-type + (%var-item id) + var-item? + (id var-item-id)) -(define-unparser-method variable-item? - (simple-unparser-method 'variable-item +(define-unparser-method var-item? + (simple-unparser-method 'var-item (lambda (item) - (list (variable-item/name item))))) + (list (var-item-id item))))) ;;; Reserved name items do not represent any form, but instead are ;;; used to reserve a particular name in a syntactic environment. If @@ -90,69 +90,68 @@ USA. ;;; one of the names being bound. (define-record-type - (make-reserved-name-item) + (reserved-name-item) reserved-name-item?) ;;; These items can't be stored in a syntactic environment. -;;; Binding items represent definitions, whether top-level or internal, keyword -;;; or variable. +;;; Definition items, whether top-level or internal, keyword or variable. -(define (make-binding-item name value) - (guarantee identifier? name 'make-binding-item) - (guarantee binding-item-value? value 'make-binding-item) - (%make-binding-item name value)) +(define (defn-item id value) + (guarantee identifier? id 'defn-item) + (guarantee defn-item-value? value 'defn-item) + (%defn-item id value)) -(define (binding-item-value? object) +(define (defn-item-value? object) (not (or (reserved-name-item? object) - (declaration-item? object)))) -(register-predicate! binding-item-value? 'binding-item-value) + (decl-item? object)))) +(register-predicate! defn-item-value? 'defn-item-value) -(define-record-type - (%make-binding-item name value) - binding-item? - (name binding-item/name) - (value binding-item/value)) +(define-record-type + (%defn-item id value) + defn-item? + (id defn-item-id) + (value defn-item-value)) -(define-unparser-method binding-item? - (simple-unparser-method 'binding-item +(define-unparser-method defn-item? + (simple-unparser-method 'defn-item (lambda (item) - (list (binding-item/name item) - (binding-item/value item))))) + (list (defn-item-id item) + (defn-item-value item))))) -;;; Body items represent sequences (e.g. BEGIN). +;;; Sequence items. -(define-record-type - (make-body-item components) - body-item? - (components body-item/components)) +(define-record-type + (seq-item elements) + seq-item? + (elements seq-item-elements)) -(define (extract-declarations-from-body body-item) - (partition declaration-item? (body-item/components body-item))) +(define (extract-declarations-from-body seq-item) + (partition decl-item? (seq-item-elements seq-item))) -(define (flatten-body-items items) +(define (flatten-seq-items items) (append-map item->list items)) (define (item->list item) - (if (body-item? item) - (flatten-body-items (body-item/components item)) + (if (seq-item? item) + (flatten-seq-items (seq-item-elements item)) (list item))) ;;; Expression items represent any kind of expression other than a ;;; run-time variable or a sequence. -(define-record-type - (make-expression-item compiler) - expression-item? - (compiler expression-item/compiler)) +(define-record-type + (expr-item compiler) + expr-item? + (compiler expr-item-compiler)) ;;; Declaration items represent block-scoped declarations that are to ;;; be passed through to the compiler. -(define-record-type - (make-declaration-item get-text) - declaration-item? - (get-text declaration-item/get-text)) +(define-record-type + (decl-item text-getter) + decl-item? + (text-getter decl-item-text-getter)) -(define (declaration-item/text item) - ((declaration-item/get-text item))) \ No newline at end of file +(define (decl-item-text item) + ((decl-item-text-getter item))) \ No newline at end of file diff --git a/src/runtime/syntax-transforms.scm b/src/runtime/syntax-transforms.scm index f5c1a0419..94571e593 100644 --- a/src/runtime/syntax-transforms.scm +++ b/src/runtime/syntax-transforms.scm @@ -32,20 +32,20 @@ USA. (declare (usual-integrations)) (define (sc-macro-transformer->expander transformer closing-environment) - (make-expander-item + (expander-item (lambda (form use-environment) (close-syntax (transformer form use-environment) (->syntactic-environment closing-environment))))) (define (rsc-macro-transformer->expander transformer closing-environment) - (make-expander-item + (expander-item (lambda (form use-environment) (close-syntax (transformer form (->syntactic-environment closing-environment)) use-environment)))) (define (er-macro-transformer->expander transformer closing-environment) - (make-expander-item + (expander-item (lambda (form use-environment) (close-syntax (transformer form (make-er-rename diff --git a/src/runtime/syntax.scm b/src/runtime/syntax.scm index da15ce629..55b260628 100644 --- a/src/runtime/syntax.scm +++ b/src/runtime/syntax.scm @@ -148,7 +148,7 @@ USA. (if (reserved-name-item? item) (syntax-error "Premature reference to reserved name:" identifier)) (or item - (make-variable-item identifier)))) + (var-item identifier)))) (define (identifier=? environment-1 identifier-1 environment-2 identifier-2) (let ((item-1 (lookup-identifier identifier-1 environment-1)) @@ -159,10 +159,10 @@ USA. ;; item, and the variable items are not cached. Therefore ;; two references to the same variable result in two ;; different variable items. - (and (variable-item? item-1) - (variable-item? item-2) - (eq? (variable-item/name item-1) - (variable-item/name item-2)))))) + (and (var-item? item-1) + (var-item? item-2) + (eq? (var-item-id item-1) + (var-item-id item-2)))))) (define (reserve-identifier senv identifier) (cond ((raw-identifier? identifier) @@ -200,10 +200,10 @@ USA. (apply error rest)) (define (classifier->keyword classifier) - (item->keyword (make-classifier-item classifier))) + (item->keyword (classifier-item classifier))) (define (compiler->keyword compiler) - (item->keyword (make-compiler-item compiler))) + (item->keyword (compiler-item compiler))) (define (item->keyword item) (close-syntax 'keyword (make-keyword-syntactic-environment 'keyword item))) -- 2.25.1