From 3f22104bb46863fef4c6ae226b7a0e88c0078a6d Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 11 Sep 1990 22:58:02 +0000 Subject: [PATCH] Fix a number of instances of syntactic keywords being used as variables. --- v7/src/runtime/lambda.scm | 68 +++++++++++++++++++-------------------- v7/src/runtime/lambdx.scm | 12 +++---- v7/src/runtime/scan.scm | 16 ++++----- v7/src/runtime/scode.scm | 22 ++++++------- v7/src/runtime/scomb.scm | 56 ++++++++++++++++---------------- v7/src/runtime/unsyn.scm | 14 ++++---- 6 files changed, 93 insertions(+), 95 deletions(-) diff --git a/v7/src/runtime/lambda.scm b/v7/src/runtime/lambda.scm index 8fa99d703..88c8b7634 100644 --- a/v7/src/runtime/lambda.scm +++ b/v7/src/runtime/lambda.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/lambda.scm,v 14.6 1990/09/11 20:44:43 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/lambda.scm,v 14.7 1990/09/11 22:57:30 cph Rel $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -119,8 +119,8 @@ MIT in each case. |# (define (lambda-body-procedures physical-body set-physical-body! receiver) (receiver - (named-lambda (wrap-body! lambda transform) - (let ((physical-body (physical-body lambda))) + (named-lambda (wrap-body! *lambda transform) + (let ((physical-body (physical-body *lambda))) (if (wrapper? physical-body) (transform (wrapper-body physical-body) (wrapper-state physical-body) @@ -130,30 +130,30 @@ MIT in each case. |# (transform physical-body '() (lambda (new-body new-state) - (set-physical-body! lambda + (set-physical-body! *lambda (make-wrapper physical-body new-body new-state))))))) - (named-lambda (wrapper-components lambda receiver) - (let ((physical-body (physical-body lambda))) + (named-lambda (wrapper-components *lambda receiver) + (let ((physical-body (physical-body *lambda))) (if (wrapper? physical-body) (receiver (wrapper-original-body physical-body) (wrapper-state physical-body)) (receiver physical-body '())))) - (named-lambda (unwrap-body! lambda) - (let ((physical-body (physical-body lambda))) + (named-lambda (unwrap-body! *lambda) + (let ((physical-body (physical-body *lambda))) (if (wrapper? physical-body) - (set-physical-body! lambda + (set-physical-body! *lambda (wrapper-original-body physical-body))))) - (named-lambda (unwrapped-body lambda) - (let ((physical-body (physical-body lambda))) + (named-lambda (unwrapped-body *lambda) + (let ((physical-body (physical-body *lambda))) (if (wrapper? physical-body) (wrapper-original-body physical-body) physical-body))) - (named-lambda (set-unwrapped-body! lambda new-body) - (if (wrapper? (physical-body lambda)) - (set-wrapper-original-body! (physical-body lambda) new-body) - (set-physical-body! lambda new-body))))) + (named-lambda (set-unwrapped-body! *lambda new-body) + (if (wrapper? (physical-body *lambda)) + (set-wrapper-original-body! (physical-body *lambda) new-body) + (set-physical-body! *lambda new-body))))) (define-integrable (make-wrapper original-body new-body state) (make-comment (vector wrapper-tag original-body state) new-body)) @@ -399,8 +399,8 @@ MIT in each case. |# (else (make-clexpr name required rest auxiliary body*))))) -(define (lambda-components lambda receiver) - (&lambda-components lambda +(define (lambda-components *lambda receiver) + (&lambda-components *lambda (lambda (name required optional rest auxiliary body) (let ((actions (and (sequence? body) (sequence-actions body)))) @@ -417,19 +417,19 @@ MIT in each case. |# true (list-has-duplicates? (cdr items))))) -(define ((dispatch-0 op-name clambda-op clexpr-op xlambda-op) lambda) - ((cond ((slambda? lambda) clambda-op) - ((slexpr? lambda) clexpr-op) - ((xlambda? lambda) xlambda-op) - (else (error "Not a lambda" op-name lambda))) - lambda)) - -(define ((dispatch-1 op-name clambda-op clexpr-op xlambda-op) lambda arg) - ((cond ((slambda? lambda) clambda-op) - ((slexpr? lambda) clexpr-op) - ((xlambda? lambda) xlambda-op) - (else (error "Not a lambda" op-name lambda))) - lambda arg)) +(define ((dispatch-0 op-name clambda-op clexpr-op xlambda-op) *lambda) + ((cond ((slambda? *lambda) clambda-op) + ((slexpr? *lambda) clexpr-op) + ((xlambda? *lambda) xlambda-op) + (else (error:illegal-datum *lambda op-name))) + *lambda)) + +(define ((dispatch-1 op-name clambda-op clexpr-op xlambda-op) *lambda arg) + ((cond ((slambda? *lambda) clambda-op) + ((slexpr? *lambda) clexpr-op) + ((xlambda? *lambda) xlambda-op) + (else (error:illegal-datum *lambda op-name))) + *lambda arg)) (define &lambda-components) (define has-internal-lambda?) @@ -510,10 +510,10 @@ MIT in each case. |# (define-integrable (make-internal-lexpr names body) (make-slambda lambda-tag:internal-lexpr names body)) -(define (internal-lambda? lambda) - (and (slambda? lambda) - (or (eq? (slambda-name lambda) lambda-tag:internal-lambda) - (eq? (slambda-name lambda) lambda-tag:internal-lexpr)))) +(define (internal-lambda? *lambda) + (and (slambda? *lambda) + (or (eq? (slambda-name *lambda) lambda-tag:internal-lambda) + (eq? (slambda-name *lambda) lambda-tag:internal-lexpr)))) (define (make-unassigned auxiliary) (map (lambda (auxiliary) diff --git a/v7/src/runtime/lambdx.scm b/v7/src/runtime/lambdx.scm index 18ab74411..24eeffa8a 100644 --- a/v7/src/runtime/lambdx.scm +++ b/v7/src/runtime/lambdx.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/lambdx.scm,v 14.2 1988/06/13 11:47:06 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/lambdx.scm,v 14.3 1990/09/11 22:57:36 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1990 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -42,14 +42,14 @@ MIT in each case. |# (lambda (auxiliary declarations body*) (make-lambda name required optional rest auxiliary declarations body*)))) -(define (lambda-components* lambda receiver) - (lambda-components lambda +(define (lambda-components* *lambda receiver) + (lambda-components *lambda (lambda (name required optional rest auxiliary declarations body) (receiver name required optional rest (make-open-block auxiliary declarations body))))) -(define (lambda-components** lambda receiver) - (lambda-components* lambda +(define (lambda-components** *lambda receiver) + (lambda-components* *lambda (lambda (name required optional rest body) (receiver (make-lambda-pattern name required optional rest) (append required optional (if (null? rest) '() (list rest))) diff --git a/v7/src/runtime/scan.scm b/v7/src/runtime/scan.scm index bd3a4556c..4e76d327f 100644 --- a/v7/src/runtime/scan.scm +++ b/v7/src/runtime/scan.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scan.scm,v 14.3 1989/04/18 16:29:59 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scan.scm,v 14.4 1990/09/11 22:57:41 cph Rel $ -Copyright (c) 1988, 1989 Massachusetts Institute of Technology +Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -65,16 +65,16 @@ MIT in each case. |# (define null-sequence '(NULL-SEQUENCE)) -(define (cons-sequence action sequence) - (cond ((object-type? sequence-2-type sequence) +(define (cons-sequence action seq) + (cond ((object-type? sequence-2-type seq) (&typed-triple-cons sequence-3-type action - (&pair-car sequence) - (&pair-cdr sequence))) - ((eq? sequence null-sequence) + (&pair-car seq) + (&pair-cdr seq))) + ((eq? seq null-sequence) action) (else - (&typed-pair-cons sequence-2-type action sequence)))) + (&typed-pair-cons sequence-2-type action seq)))) ;;;; Scanning diff --git a/v7/src/runtime/scode.scm b/v7/src/runtime/scode.scm index b0e832404..420de4f61 100644 --- a/v7/src/runtime/scode.scm +++ b/v7/src/runtime/scode.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scode.scm,v 14.9 1990/02/09 19:10:58 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scode.scm,v 14.10 1990/09/11 22:57:46 cph Rel $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -104,7 +104,7 @@ MIT in each case. |# (define (string->uninterned-symbol string) (if (not (string? string)) - (error error-type:wrong-type-argument string)) + (error:illegal-datum string 'STRING->UNINTERNED-SYMBOL)) (&typed-pair-cons (ucode-type uninterned-symbol) string (make-unbound-reference-trap))) @@ -117,7 +117,7 @@ MIT in each case. |# (define (symbol-name symbol) (if (not (symbol? symbol)) - (error error-type:wrong-type-argument symbol)) + (error:illegal-datum symbol 'SYMBOL-NAME)) (system-pair-car symbol)) (define-integrable (symbol->string symbol) @@ -279,9 +279,9 @@ MIT in each case. |# (define-integrable (access-name expression) (system-pair-cdr expression)) -(define (access-components access receiver) - (receiver (access-environment access) - (access-name access))) +(define (access-components expression receiver) + (receiver (access-environment expression) + (access-name expression))) ;;;; Absolute Reference @@ -317,9 +317,9 @@ MIT in each case. |# (define-integrable (in-package-expression expression) (&pair-cdr expression)) -(define (in-package-components in-package receiver) - (receiver (in-package-environment in-package) - (in-package-expression in-package))) +(define (in-package-components expression receiver) + (receiver (in-package-environment expression) + (in-package-expression expression))) ;;;; Delay @@ -332,5 +332,5 @@ MIT in each case. |# (define-integrable (delay-expression expression) (&singleton-element expression)) -(define-integrable (delay-components delay receiver) - (receiver (delay-expression delay))) \ No newline at end of file +(define-integrable (delay-components expression receiver) + (receiver (delay-expression expression))) \ No newline at end of file diff --git a/v7/src/runtime/scomb.scm b/v7/src/runtime/scomb.scm index 3eaedb77a..aff62ef68 100644 --- a/v7/src/runtime/scomb.scm +++ b/v7/src/runtime/scomb.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scomb.scm,v 14.8 1990/07/19 21:44:33 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scomb.scm,v 14.9 1990/09/11 22:57:55 cph Rel $ Copyright (c) 1988, 1990 Massachusetts Institute of Technology @@ -150,30 +150,30 @@ MIT in each case. |# (or (object-type? (ucode-type sequence-2) object) (object-type? (ucode-type sequence-3) object))) -(define (sequence-actions sequence) - (cond ((object-type? (ucode-type sequence-2) sequence) - (append! (sequence-actions (&pair-car sequence)) - (sequence-actions (&pair-cdr sequence)))) - ((object-type? (ucode-type sequence-3) sequence) - (append! (sequence-actions (&triple-first sequence)) - (sequence-actions (&triple-second sequence)) - (sequence-actions (&triple-third sequence)))) +(define (sequence-actions expression) + (cond ((object-type? (ucode-type sequence-2) expression) + (append! (sequence-actions (&pair-car expression)) + (sequence-actions (&pair-cdr expression)))) + ((object-type? (ucode-type sequence-3) expression) + (append! (sequence-actions (&triple-first expression)) + (sequence-actions (&triple-second expression)) + (sequence-actions (&triple-third expression)))) (else - (list sequence)))) - -(define (sequence-immediate-actions sequence) - (cond ((object-type? (ucode-type sequence-2) sequence) - (list (&pair-car sequence) - (&pair-cdr sequence))) - ((object-type? (ucode-type sequence-3) sequence) - (list (&triple-first sequence) - (&triple-second sequence) - (&triple-third sequence))) + (list expression)))) + +(define (sequence-immediate-actions expression) + (cond ((object-type? (ucode-type sequence-2) expression) + (list (&pair-car expression) + (&pair-cdr expression))) + ((object-type? (ucode-type sequence-3) expression) + (list (&triple-first expression) + (&triple-second expression) + (&triple-third expression))) (else - (error "sequence-immediate-actions: not a sequence" sequence)))) + (error:illegal-datum expression 'SEQUENCE-IMMEDIATE-ACTIONS)))) -(define-integrable (sequence-components sequence receiver) - (receiver (sequence-actions sequence))) +(define-integrable (sequence-components expression receiver) + (receiver (sequence-actions expression))) ;;;; Conditional @@ -309,9 +309,7 @@ MIT in each case. |# ,combination)) ,case-n) (ELSE - (ERROR ,(string-append (symbol->string name) - ": Illegal combination") - ,combination)))))) + (ERROR:ILLEGAL-DATUM ,combination ',name)))))) (define (combination-size combination) (combination-dispatch combination-size combination @@ -358,8 +356,8 @@ MIT in each case. |# (and (the-environment? (car operands)) (symbol? (cadr operands)))))) -(define-integrable (unassigned?-name unassigned?) - (cadr (combination-operands unassigned?))) +(define-integrable (unassigned?-name expression) + (cadr (combination-operands expression))) -(define-integrable (unassigned?-components unassigned? receiver) - (receiver (unassigned?-name unassigned?))) \ No newline at end of file +(define-integrable (unassigned?-components expression receiver) + (receiver (unassigned?-name expression))) \ No newline at end of file diff --git a/v7/src/runtime/unsyn.scm b/v7/src/runtime/unsyn.scm index 39a200300..5c4a89186 100644 --- a/v7/src/runtime/unsyn.scm +++ b/v7/src/runtime/unsyn.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unsyn.scm,v 14.9 1990/09/11 20:45:54 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unsyn.scm,v 14.10 1990/09/11 22:58:02 cph Rel $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -72,7 +72,7 @@ MIT in each case. |# (define (unsyntax-with-substitutions scode alist) (if (not (alist? alist)) - (error "substitutions not an alist" alist)) + (error:illegal-datum alist 'UNSYNTAX-WITH-SUBSTITUTIONS)) (fluid-let ((substitutions alist)) (unsyntax scode))) @@ -165,8 +165,8 @@ MIT in each case. |# '() `(,(unsyntax-object value)))) -(define (unsyntax-UNASSIGNED?-object unassigned?) - `(UNASSIGNED? ,(unassigned?-name unassigned?))) +(define (unsyntax-UNASSIGNED?-object object) + `(UNASSIGNED? ,(unassigned?-name object))) (define (unsyntax-COMMENT-object comment) (let ((expression (unsyntax-object (comment-expression comment)))) @@ -218,8 +218,8 @@ MIT in each case. |# (define (unsyntax-DELAY-object object) `(DELAY ,(unsyntax-object (delay-expression object)))) -(define (unsyntax-IN-PACKAGE-object in-package) - (in-package-components in-package +(define (unsyntax-IN-PACKAGE-object object) + (in-package-components object (lambda (environment expression) `(IN-PACKAGE ,(unsyntax-object environment) ,@(unsyntax-sequence expression))))) @@ -331,7 +331,7 @@ MIT in each case. |# (define (unsyntax-lambda-list expression) (if (not (lambda? expression)) - (error "Must be a lambda expression" expression)) + (error:illegal-datum expression 'UNSYNTAX-LAMBDA-LIST)) (lambda-components** expression (lambda (name required optional rest body) name body -- 2.25.1