variables.
#| -*-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
(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)
(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)))))
\f
(define-integrable (make-wrapper original-body new-body state)
(make-comment (vector wrapper-tag original-body state) new-body))
(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))))
true
(list-has-duplicates? (cdr items)))))
\f
-(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?)
(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)
#| -*-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
(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)))
#| -*-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
(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))))
\f
;;;; Scanning
#| -*-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
(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)))
(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)
(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
(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
(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
#| -*-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
(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)))
\f
;;;; Conditional
,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
(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
#| -*-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
(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)))
'()
`(,(unsyntax-object value))))
\f
-(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))))
(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)))))
(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
projects / mit-scheme.git / commitdiff