From 89eb73c035f05ae53b1148ef8a83e1d4030b2dd8 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 16 Oct 2001 17:26:15 +0000 Subject: [PATCH] 0.pre7.68: more name systematization.. ..s/variable-length/var-length/ ..s/variable-name/ambiguous-var-name/ ..s/fast-read-variable-integer/fast-read-var-u-integer/ ..s/variable-lexical-p/var-lexical-p/ ..s/variable-special-p/var-special-p/ ..s/variable-globally-special-p/var-globally-special-p/ ..s/variable-declaration/var-declaration/ ..s/variable-same/var-same/ merged AD's fix-TRACE-nesting patch (sbcl-devel 2001-10-16) also went back to the original sources to try to see how this got --- package-data-list.lisp-expr | 10 +-- src/code/debug-int.lisp | 23 +++--- src/code/defstruct.lisp | 1 - src/code/load.lisp | 2 +- src/code/room.lisp | 2 +- src/compiler/assem.lisp | 10 +-- src/compiler/generic/vm-macs.lisp | 22 +++--- src/pcl/boot.lisp | 11 ++- src/pcl/defs.lisp | 6 +- src/pcl/iterate.lisp | 155 +++++++++++++++++++------------------ src/pcl/std-class.lisp | 13 ++-- src/pcl/vector.lisp | 47 +++++------ src/pcl/walk.lisp | 22 +++--- tests/walk.impure.lisp | 6 +- version.lisp-expr | 2 +- 15 files changed, 169 insertions(+), 163 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 12c4056..06edca0 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -351,7 +351,7 @@ like *STACK-TOP-HINT*" "DEBUG-SOURCE-START-POSITIONS" "DEBUG-SOURCE" "DEBUG-SOURCE-P") :export ("ACTIVATE-BREAKPOINT" - "AMBIGUOUS-DEBUG-VARS" "AMBIGUOUS-VARIABLE-NAME" "BREAKPOINT" + "AMBIGUOUS-DEBUG-VARS" "AMBIGUOUS-VAR-NAME" "BREAKPOINT" "BREAKPOINT-ACTIVE-P" "BREAKPOINT-HOOK-FUNCTION" "BREAKPOINT-INFO" "BREAKPOINT-KIND" "BREAKPOINT-P" "BREAKPOINT-WHAT" "CODE-LOCATION" "CODE-LOCATION-DEBUG-BLOCK" "CODE-LOCATION-DEBUG-FUN" @@ -859,7 +859,7 @@ retained, possibly temporariliy, because it might be used internally." "FAST-READ-CHAR-REFILL" "FAST-READ-S-INTEGER" "FAST-READ-U-INTEGER" - "FAST-READ-VARIABLE-U-INTEGER" + "FAST-READ-VAR-U-INTEGER" "FILE-NAME" "INTERN*" "PREPARE-FOR-FAST-READ-BYTE" @@ -1858,9 +1858,9 @@ structure representations" :use ("CL" "SB!INT" "SB!EXT") :export ("DEFINE-WALKER-TEMPLATE" "WALK-FORM" "*WALK-FORM-EXPAND-MACROS-P*" - "VARIABLE-LEXICAL-P" "VARIABLE-SPECIAL-P" - "VARIABLE-GLOBALLY-SPECIAL-P" - "*VARIABLE-DECLARATIONS*" "VARIABLE-DECLARATION" + "VAR-LEXICAL-P" "VAR-SPECIAL-P" + "VAR-GLOBALLY-SPECIAL-P" + "*VAR-DECLARATIONS*" "VAR-DECLARATION" ;; These were exported from the original PCL version of this ;; package, but aren't used in SBCL. diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 192ebda..c2b2757 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -105,13 +105,13 @@ (invalid-value-debug-var condition) (invalid-value-frame condition))))) -(define-condition ambiguous-variable-name (debug-condition) - ((name :reader ambiguous-variable-name-name :initarg :name) - (frame :reader ambiguous-variable-name-frame :initarg :frame)) +(define-condition ambiguous-var-name (debug-condition) + ((name :reader ambiguous-var-name-name :initarg :name) + (frame :reader ambiguous-var-name-frame :initarg :frame)) (:report (lambda (condition stream) (format stream "~&~S names more than one valid variable in ~S." - (ambiguous-variable-name-name condition) - (ambiguous-variable-name-frame condition))))) + (ambiguous-var-name-name condition) + (ambiguous-var-name-frame condition))))) ;;;; errors and DEBUG-SIGNAL @@ -2704,7 +2704,7 @@ ;;; The returned function takes the frame to get values from as its ;;; argument, and it returns the values of FORM. The returned function ;;; can signal the following conditions: INVALID-VALUE, -;;; AMBIGUOUS-VARIABLE-NAME, and FRAME-FUN-MISMATCH. +;;; AMBIGUOUS-VAR-NAME, and FRAME-FUN-MISMATCH. (defun preprocess-for-eval (form loc) (declare (type code-location loc)) (let ((n-frame (gensym)) @@ -2728,10 +2728,12 @@ (:valid (specs `(,name (debug-var-value ',var ,n-frame)))) (:unknown - (specs `(,name (debug-signal 'invalid-value :debug-var ',var + (specs `(,name (debug-signal 'invalid-value + :debug-var ',var :frame ,n-frame)))) (:ambiguous - (specs `(,name (debug-signal 'ambiguous-variable-name :name ',name + (specs `(,name (debug-signal 'ambiguous-var-name + :name ',name :frame ,n-frame))))))) (let ((res (coerce `(lambda (,n-frame) (declare (ignorable ,n-frame)) @@ -2900,8 +2902,9 @@ (do ((frame frame (frame-down frame))) ((not frame) nil) (when (and (compiled-frame-p frame) - (eq lra - (get-context-value frame lra-save-offset lra-sc-offset))) + (#-x86 eq #+x86 sap= + lra + (get-context-value frame lra-save-offset lra-sc-offset))) (return t))))) ;;;; ACTIVATE-BREAKPOINT diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 00dd740..ab9d722 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -868,7 +868,6 @@ ;;; (INFO :FUNCTION :INLINE-EXPANSSION-DESIGNATOR ..)) for the reader ;;; and writer functions of the slot described by DSD. (defun accessor-inline-expansion-designators (dd dsd) - ;; ordinary tagged non-raw slot case (values (lambda () `(lambda (instance) (declare (type ,(dd-name dd) instance)) diff --git a/src/code/load.lisp b/src/code/load.lisp index e68ff75..bd764fd 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -57,7 +57,7 @@ ((>= cnt n) res))) ;;; Like Fast-Read-U-Integer, but the size may be determined at run time. -(defmacro fast-read-variable-u-integer (n) +(defmacro fast-read-var-u-integer (n) (let ((n-pos (gensym)) (n-res (gensym)) (n-cnt (gensym))) diff --git a/src/code/room.lisp b/src/code/room.lisp index 6d16b35..b8d966e 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -32,7 +32,7 @@ (let ((widetag (primitive-object-widetag obj)) (lowtag (primitive-object-lowtag obj)) (name (primitive-object-name obj)) - (variable (primitive-object-variable-length obj)) + (variable (primitive-object-var-length obj)) (size (primitive-object-size obj))) (cond ((not lowtag)) diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp index 290b8c5..a02c49d 100644 --- a/src/compiler/assem.lisp +++ b/src/compiler/assem.lisp @@ -139,9 +139,9 @@ ;; how many instructions follow the branch. branch ;; This attribute indicates that this ``instruction'' can be - ;; variable length, and therefore better never be used in a branch - ;; delay slot. - variable-length) + ;; variable length, and therefore had better never be used in a + ;; branch delay slot. + var-length) (defstruct (instruction (:include sset-element) @@ -316,7 +316,7 @@ (when countdown (decf countdown) (aver (not (instruction-attributep (inst-attributes inst) - variable-length)))) + var-length)))) (cond ((instruction-attributep (inst-attributes inst) branch) (unless countdown (setf countdown (inst-delay inst))) @@ -529,7 +529,7 @@ p ;; the branch has two dependents and one of them dpends on (let ((inst (car remaining))) (unless (and delay-slot-p (instruction-attributep (inst-attributes inst) - variable-length)) + var-length)) ;; We've got us a live one here. Go for it. #!+sb-show-assem (format *trace-output* "emitting ~S~%" inst) ;; Delete it from the list of insts. diff --git a/src/compiler/generic/vm-macs.lisp b/src/compiler/generic/vm-macs.lisp index 58dc351..6753edd 100644 --- a/src/compiler/generic/vm-macs.lisp +++ b/src/compiler/generic/vm-macs.lisp @@ -50,7 +50,7 @@ (options nil :type list) (slots nil :type list) (size 0 :type fixnum) - (variable-length nil :type (member t nil))) + (var-length nil :type (member t nil))) (defvar *primitive-objects* nil) @@ -67,9 +67,9 @@ &rest slot-specs) (collect ((slots) (exports) (constants) (forms) (inits)) (let ((offset (if widetag 1 0)) - (variable-length nil)) + (var-length nil)) (dolist (spec slot-specs) - (when variable-length + (when var-length (error "No more slots can follow a :rest-p slot.")) (destructuring-bind (slot-name &rest options @@ -103,14 +103,14 @@ (when init (inits (cons init offset))) (when rest-p - (setf variable-length t)) + (setf var-length t)) (incf offset length))) - (unless variable-length + (unless var-length (let ((size (symbolicate name "-SIZE"))) (constants `(defconstant ,size ,offset)) (exports size))) (when alloc-trans - (forms `(def-alloc ,alloc-trans ,offset ,variable-length ,widetag + (forms `(def-alloc ,alloc-trans ,offset ,var-length ,widetag ,lowtag ',(inits)))) `(progn (eval-when (:compile-toplevel :load-toplevel :execute) @@ -120,7 +120,7 @@ :lowtag lowtag :slots (slots) :size offset - :variable-length variable-length)) + :var-length var-length)) ,@(constants)) ,@(forms))))) @@ -151,10 +151,10 @@ (defmacro def-setter (name offset lowtag) `(%def-setter ',name ,offset ,lowtag)) -(defun %def-alloc (name words variable-length header lowtag inits) +(defun %def-alloc (name words var-length header lowtag inits) (let ((info (function-info-or-lose name))) (setf (function-info-ir2-convert info) - (if variable-length + (if var-length #'(lambda (node block) (ir2-convert-variable-allocation node block name words header lowtag inits)) @@ -163,8 +163,8 @@ lowtag inits))))) name) -(defmacro def-alloc (name words variable-length header lowtag inits) - `(%def-alloc ',name ,words ,variable-length ,header ,lowtag ,inits)) +(defmacro def-alloc (name words var-length header lowtag inits) + `(%def-alloc ',name ,words ,var-length ,header ,lowtag ,inits)) ;;;; some general constant definitions diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 40c79da..221647a 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -540,7 +540,7 @@ bootstrapping. ;; These declarations seem to be used by PCL to pass ;; information to itself; when I tried to delete 'em ;; ca. 0.6.10 it didn't work. I'm not sure how - ;; they work, but note the (VARIABLE-DECLARATION '%CLASS ..) + ;; they work, but note the (VAR-DECLARATION '%CLASS ..) ;; expression in CAN-OPTIMIZE-ACCESS1. -- WHN 2000-12-30 ,@(remove nil (mapcar (lambda (a s) (and (symbolp s) @@ -2214,7 +2214,7 @@ bootstrapping. `((declare (%variable-rebinding ,in ,instance))))) ,in (symbol-macrolet ,(mapcar #'(lambda (slot-entry) - (let ((variable-name + (let ((var-name (if (symbolp slot-entry) slot-entry (car slot-entry))) @@ -2222,7 +2222,7 @@ bootstrapping. (if (symbolp slot-entry) slot-entry (cadr slot-entry)))) - `(,variable-name + `(,var-name (slot-value ,in ',slot-name)))) slots) ,@body)))) @@ -2238,9 +2238,8 @@ bootstrapping. `((declare (%variable-rebinding ,in ,instance))))) ,in (symbol-macrolet ,(mapcar #'(lambda (slot-entry) - (let ((variable-name (car slot-entry)) + (let ((var-name (car slot-entry)) (accessor-name (cadr slot-entry))) - `(,variable-name - (,accessor-name ,in)))) + `(,var-name (,accessor-name ,in)))) slots) ,@body)))) diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index 2d9bcf0..e0ad9f7 100644 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -298,11 +298,11 @@ (push (list class-name symbol) *built-in-wrapper-symbols*) symbol))) -(pushnew '%class *variable-declarations*) -(pushnew '%variable-rebinding *variable-declarations*) +(pushnew '%class *var-declarations*) +(pushnew '%variable-rebinding *var-declarations*) (defun variable-class (var env) - (caddr (variable-declaration 'class var env))) + (caddr (var-declaration 'class var env))) (defvar *name->class->slotd-table* (make-hash-table)) diff --git a/src/pcl/iterate.lisp b/src/pcl/iterate.lisp index a5b2bdf..ebfbf98 100644 --- a/src/pcl/iterate.lisp +++ b/src/pcl/iterate.lisp @@ -1,6 +1,14 @@ ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. +;;;; FIXME: It'd be nice to get rid of all 750 lines of code in this +;;;; file, plus miscellaneous cruft elsewhere (e.g. the definition of +;;;; the SB-ITERATE package). There are only 20 calls to this ITERATE +;;;; macro in the PCL code. (There's another ITERATE macro used in the +;;;; classic CMU CL code, but that's different.) Most if not all of +;;;; them would be easy to replace with ANSI LOOP or simpler standard +;;;; iteration constructs. + ;;;; This software is derived from software originally released by Xerox ;;;; Corporation. Copyright and release statements follow. Later modifications ;;;; to the software are in the public domain and are provided with @@ -341,10 +349,12 @@ (parse-declarations let-body locals) (cond ((setq specials (extract-special-bindings locals localdecls)) - (maybe-warn (cond ((find-if #'variable-globally-special-p - specials) - ; This could be the fault of a - ; user proclamation. + (maybe-warn (cond ((find-if + #'var-globally-special-p + specials) + ;; This could be the + ;; fault of a user + ;; proclamation. :user) (t :definition)) @@ -402,61 +412,55 @@ ;;; (ITERATE or ITERATE*), for purpose of error messages. On success, we ;;; return the transformed body; on failure, :ABORT. - (walk-form let-body iterate-env - #'(lambda (form context env) - (declare (ignore context)) - - ;; Need to substitute RENAMED-VARS, as well as turn - ;; (FUNCALL finish-arg) into the finish form - (cond ((symbolp form) - (let (renaming) - (cond ((and (eq form finish-arg) - (variable-same-p form env - iterate-env)) - ; An occurrence of the finish - ; arg outside of FUNCALL - ; context--I can't handle this - (maybe-warn :definition "Couldn't optimize iterate form because generator ~S does something with its FINISH arg besides FUNCALL it." - (second clause)) - (return-from iterate-transform-body - :abort)) - ((and (setq renaming (assoc form - renamed-vars - )) - (variable-same-p form env - iterate-env)) - ; Reference to one of the vars - ; we're renaming - (cdr renaming)) - ((and (member form bound-vars) - (variable-same-p form env - iterate-env)) - ; FORM is a var that is bound - ; in this same ITERATE, or - ; bound later in this ITERATE*. - ; This is a conflict. - (maybe-warn :user "Couldn't optimize iterate form because generator ~S is closed over ~S, in conflict with a subsequent iteration variable." - (second clause) - form) - (return-from iterate-transform-body - :abort)) - (t form)))) - ((and (consp form) - (eq (first form) - 'funcall) - (eq (second form) - finish-arg) - (variable-same-p (second form) - env iterate-env)) - ; (FUNCALL finish-arg) => - ; finish-form - (unless (null (cddr form)) - (maybe-warn :definition - "Generator for ~S applied its finish arg to > 0 arguments ~S--ignored." - (second clause) - (cddr form))) - finish-form) - (t form))))) + (walk-form + let-body + iterate-env + (lambda (form context env) + (declare (ignore context)) + + ;; We need to substitute RENAMED-VARS, as well as turn + ;; (FUNCALL finish-arg) into the finish form. + (cond ((symbolp form) + (let (renaming) + (cond ((and (eq form finish-arg) + (var-same-p form env iterate-env)) + ;; an occurrence of the finish arg outside + ;; of FUNCALL context: I can't handle this! + (maybe-warn :definition "Couldn't optimize iterate form because generator ~S does something with its FINISH arg besides FUNCALL it." + (second clause)) + (return-from iterate-transform-body + :abort)) + ((and (setq renaming (assoc form renamed-vars)) + (var-same-p form env iterate-env)) + ;; Reference to one of the vars + ;; we're renaming + (cdr renaming)) + ((and (member form bound-vars) + (var-same-p form env iterate-env)) + ;; FORM is a var that is bound in this same + ;; ITERATE, or bound later in this ITERATE*. + ;; This is a conflict. + (maybe-warn :user "Couldn't optimize iterate form because generator ~S is closed over ~S, in conflict with a subsequent iteration variable." + (second clause) + form) + (return-from iterate-transform-body + :abort)) + (t form)))) + ((and (consp form) + (eq (first form) + 'funcall) + (eq (second form) + finish-arg) + (var-same-p (second form) env + iterate-env)) + ;; (FUNCALL finish-arg) => finish-form + (unless (null (cddr form)) + (maybe-warn :definition + "Generator for ~S applied its finish arg to > 0 arguments ~S--ignored." + (second clause) + (cddr form))) + finish-form) + (t form))))) (defun parse-declarations @@ -509,7 +513,7 @@ ;; Return the subset of VARS that are special, either globally or ;; because of a declaration in DECLS - (let ((specials (remove-if-not #'variable-globally-special-p vars))) + (let ((specials (remove-if-not #'var-globally-special-p vars))) (dolist (d decls) (when (eq (car d) 'special) @@ -606,7 +610,7 @@ (let (pair) (cond ((and (symbolp form) (setq pair (assoc form alist)) - (variable-same-p form subenv env)) + (var-same-p form subenv env)) (cdr pair)) (t form)))))) @@ -656,9 +660,9 @@ (t ; General case--I know nothing `(multiple-value-setq ,vars ,expr)))) -(defun variable-same-p (var env1 env2) - (eq (variable-lexical-p var env1) - (variable-lexical-p var env2))) +(defun var-same-p (var env1 env2) + (eq (var-lexical-p var env1) + (var-lexical-p var env2))) (defun maybe-warn (type &rest warn-args) @@ -1009,8 +1013,7 @@ (declare (ignore context)) (let (pair) (cond ((or (not (symbolp form)) - (not (variable-same-p form subenv - env))) + (not (var-same-p form subenv env))) ; non-variable or one that has ; been rebound form) @@ -1082,11 +1085,11 @@ ,(second form))) (t ; FN = (lambda (value) ...) (dolist (s (third info)) - (unless (or (variable-same-p s env - gathering-env) - (and (variable-special-p + (unless (or (var-same-p s env + gathering-env) + (and (var-special-p s env) - (variable-special-p + (var-special-p s gathering-env))) ;; Some var used free in the LAMBDA form has been @@ -1108,7 +1111,7 @@ (list fn (second form)))))) ((and (setq info (member site *active-gatherers*)) (or (eq site '*anonymous-gathering-site*) - (variable-same-p site env (fourth info)))) + (var-same-p site env (fourth info)))) ; Some other GATHERING will ; take care of this form, so ; pass it up for now. @@ -1133,7 +1136,7 @@ `(%orphaned-gather ,@(cdr form))))) ((and (symbolp form) (setq info (assoc form acc-info)) - (variable-same-p form env gathering-env)) + (var-same-p form env gathering-env)) ; A variable reference to a ; gather binding from ; environment TEM @@ -1198,10 +1201,10 @@ #'(lambda nil result)))) (defmacro summing (&key (initial-value 0)) - `(let ((sum ,initial-value)) - (values #'(lambda (value) - (setq sum (+ sum value))) - #'(lambda nil sum)))) + `(let ((sum ,initial-value)) + (values #'(lambda (value) + (setq sum (+ sum value))) + #'(lambda nil sum)))) ;;; It's easier to read expanded code if PROG1 gets left alone. (define-walker-template prog1 (nil return sb-walker::repeat (eval))) diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 37fde27..a114b6d 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -709,10 +709,11 @@ (unless (eq (car o) (car n)) (return t))))) owrapper) (t - ;; This will initialize the new wrapper to have the same - ;; state as the old wrapper. We will then have to change - ;; that. This may seem like wasted work (it is), but the - ;; spec requires that we call make-instances-obsolete. + ;; This will initialize the new wrapper to have the + ;; same state as the old wrapper. We will then have + ;; to change that. This may seem like wasted work + ;; (and it is), but the spec requires that we call + ;; MAKE-INSTANCES-OBSOLETE. (make-instances-obsolete class) (class-wrapper class))))) @@ -1185,8 +1186,8 @@ (old-class-slots (wrapper-class-slots old-wrapper))) ;; "The values of local slots specified by both the class CTO and - ;; CFROM are retained. If such a local slot was unbound, it remains - ;; unbound." + ;; CFROM are retained. If such a local slot was unbound, it + ;; remains unbound." (iterate ((new-slot (list-elements new-layout)) (new-position (interval :from 0))) (let ((old-position (posq new-slot old-layout))) diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index 444b3d6..37226a7 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -415,15 +415,13 @@ ;; against 'THE scattered through the PCL code. (setq var (caddr var))) (when (symbolp var) - (let* ((rebound? (caddr (variable-declaration '%variable-rebinding - var - env))) + (let* ((rebound? (caddr (var-declaration '%variable-rebinding var env))) (parameter-or-nil (car (memq (or rebound? var) required-parameters)))) (when parameter-or-nil - (let* ((class-name (caddr (variable-declaration '%class - parameter-or-nil - env))) + (let* ((class-name (caddr (var-declaration '%class + parameter-or-nil + env))) (class (find-class class-name nil))) (when (or (not (eq *boot-state* 'complete)) (and class (not (class-finalized-p class)))) @@ -574,12 +572,14 @@ (eq (car form) 'the)) (setq form (caddr form))) (or (and (symbolp form) - (let* ((rebound? (caddr (variable-declaration '%variable-rebinding - form env))) + (let* ((rebound? (caddr (var-declaration '%variable-rebinding + form + env))) (parameter-or-nil (car (assq (or rebound? form) slots)))) (when parameter-or-nil - (let* ((class-name (caddr (variable-declaration - 'class parameter-or-nil env)))) + (let* ((class-name (caddr (var-declaration 'class + parameter-or-nil + env)))) (when (and class-name (not (eq class-name t))) (position parameter-or-nil slots :key #'car)))))) (if (constantp form) @@ -892,7 +892,8 @@ slot-vars pv-parameters)) ,@body))) -;;; This gets used only when the default MAKE-METHOD-LAMBDA is overridden. +;;; This gets used only when the default MAKE-METHOD-LAMBDA is +;;; overridden. (defmacro pv-env ((pv calls pv-table-symbol pv-parameters) &rest forms) `(let* ((.pv-table. ,pv-table-symbol) @@ -906,7 +907,7 @@ ,pv ,calls ,@forms)) -(defvar *non-variable-declarations* +(defvar *non-var-declarations* ;; FIXME: VALUES was in this list, conditionalized with #+CMU, but I ;; don't *think* CMU CL had, or SBCL has, VALUES declarations. If ;; SBCL doesn't have 'em, VALUES should probably be removed from @@ -914,11 +915,11 @@ '(values %method-name %method-lambda-list optimize ftype inline notinline)) -(defvar *variable-declarations-with-argument* +(defvar *var-declarations-with-argument* '(%class type)) -(defvar *variable-declarations-without-argument* +(defvar *var-declarations-without-argument* '(ignore ignorable special dynamic-extent ;; FIXME: Possibly this entire list and variable could go away. @@ -946,20 +947,20 @@ (dolist (form (cdr decl)) (when (consp form) (let ((declaration-name (car form))) - (if (member declaration-name *non-variable-declarations*) + (if (member declaration-name *non-var-declarations*) (push `(declare ,form) outer-decls) (let ((arg-p (member declaration-name - *variable-declarations-with-argument*)) + *var-declarations-with-argument*)) (non-arg-p (member declaration-name - *variable-declarations-without-argument*)) + *var-declarations-without-argument*)) (dname (list (pop form))) (inners nil) (outers nil)) (unless (or arg-p non-arg-p) ;; FIXME: This warning, and perhaps the - ;; various *VARIABLE-DECLARATIONS-FOO* and/or - ;; *NON-VARIABLE-DECLARATIONS* variables, + ;; various *VAR-DECLARATIONS-FOO* and/or + ;; *NON-VAR-DECLARATIONS* variables, ;; could probably go away now that we're not ;; trying to be portable between different ;; CLTL1 hosts the way PCL was. (Note that to @@ -971,11 +972,11 @@ (Assuming it is a variable declaration without argument)." declaration-name 'split-declarations declaration-name - '*non-variable-declarations* - '*variable-declarations-with-argument* - '*variable-declarations-without-argument*) + '*non-var-declarations* + '*var-declarations-with-argument* + '*var-declarations-without-argument*) (push declaration-name - *variable-declarations-without-argument*)) + *var-declarations-without-argument*)) (when arg-p (setq dname (append dname (list (pop form))))) (dolist (var form) diff --git a/src/pcl/walk.lisp b/src/pcl/walk.lisp index 6f51770..b1d8865 100644 --- a/src/pcl/walk.lisp +++ b/src/pcl/walk.lisp @@ -244,7 +244,7 @@ (defun note-lexical-binding (thing env) (push (list thing :lexical-var) (cadddr (env-lock env)))) -(defun variable-lexical-p (var env) +(defun var-lexical-p (var env) (let ((entry (member var (env-lexical-variables env) :key #'car))) (when (eq (cadar entry) :lexical-var) entry))) @@ -254,22 +254,22 @@ (when (eq (cadar entry) :macro) entry))) -(defvar *variable-declarations* '(special)) +(defvar *var-declarations* '(special)) -(defun variable-declaration (declaration var env) - (if (not (member declaration *variable-declarations*)) +(defun var-declaration (declaration var env) + (if (not (member declaration *var-declarations*)) (error "~S is not a recognized variable declaration." declaration) - (let ((id (or (variable-lexical-p var env) var))) + (let ((id (or (var-lexical-p var env) var))) (dolist (decl (env-declarations env)) (when (and (eq (car decl) declaration) (eq (cadr decl) id)) (return decl)))))) -(defun variable-special-p (var env) - (or (not (null (variable-declaration 'special var env))) - (variable-globally-special-p var))) +(defun var-special-p (var env) + (or (not (null (var-declaration 'special var env))) + (var-globally-special-p var))) -(defun variable-globally-special-p (symbol) +(defun var-globally-special-p (symbol) (eq (info :variable :kind symbol) :special)) ;;;; handling of special forms @@ -588,9 +588,9 @@ (let ((type (car declaration)) (name (cadr declaration)) (args (cddr declaration))) - (if (member type *variable-declarations*) + (if (member type *var-declarations*) (note-declaration `(,type - ,(or (variable-lexical-p name env) name) + ,(or (var-lexical-p name env) name) ,.args) env) (note-declaration declaration env)) diff --git a/tests/walk.impure.lisp b/tests/walk.impure.lisp index b874f10..8642df7 100644 --- a/tests/walk.impure.lisp +++ b/tests/walk.impure.lisp @@ -37,8 +37,8 @@ #'(lambda (x y env) (format t "~&Form: ~S ~3T Context: ~A" x y) (when (symbolp x) - (let ((lexical (variable-lexical-p x env)) - (special (variable-special-p x env))) + (let ((lexical (var-lexical-p x env)) + (special (var-special-p x env))) (when lexical (format t ";~3T") (format t "lexically bound")) @@ -940,7 +940,7 @@ Form: NIL Context: EVAL; bound: NIL #'(lambda (form context env) (declare (ignore context)) (when (and (symbolp form) - (variable-lexical-p form env)) + (var-lexical-p form env)) (push form the-lexical-variables)) form)) (or (and (= (length the-lexical-variables) 3) diff --git a/version.lisp-expr b/version.lisp-expr index 217fa19..1de7049 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.67" +"0.pre7.69" -- 1.7.10.4