0.pre7.68:
authorWilliam Harold Newman <william.newman@airmail.net>
Tue, 16 Oct 2001 17:26:15 +0000 (17:26 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Tue, 16 Oct 2001 17:26:15 +0000 (17:26 +0000)
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

15 files changed:
package-data-list.lisp-expr
src/code/debug-int.lisp
src/code/defstruct.lisp
src/code/load.lisp
src/code/room.lisp
src/compiler/assem.lisp
src/compiler/generic/vm-macs.lisp
src/pcl/boot.lisp
src/pcl/defs.lisp
src/pcl/iterate.lisp
src/pcl/std-class.lisp
src/pcl/vector.lisp
src/pcl/walk.lisp
tests/walk.impure.lisp
version.lisp-expr

index 12c4056..06edca0 100644 (file)
@@ -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.
index 192ebda..c2b2757 100644 (file)
                     (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)))))
 \f
 ;;;; errors and DEBUG-SIGNAL
 
 ;;; 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))
            (: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))
     (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)))))
 \f
 ;;;; ACTIVATE-BREAKPOINT
index 00dd740..ab9d722 100644 (file)
 ;;; (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))
index e68ff75..bd764fd 100644 (file)
@@ -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)))
index 6d16b35..b8d966e 100644 (file)
@@ -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))
index 290b8c5..a02c49d 100644 (file)
   ;; 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)
     (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.
index 58dc351..6753edd 100644 (file)
@@ -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
          (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)
                                     :lowtag lowtag
                                     :slots (slots)
                                     :size offset
-                                    :variable-length variable-length))
+                                    :var-length var-length))
           ,@(constants))
         ,@(forms)))))
 \f
 (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))
                                                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))
 \f
 ;;;; some general constant definitions
 
index 40c79da..221647a 100644 (file)
@@ -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))))
index 2d9bcf0..e0ad9f7 100644 (file)
        (push (list class-name symbol) *built-in-wrapper-symbols*)
        symbol)))
 \f
-(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))
 
index a5b2bdf..ebfbf98 100644 (file)
@@ -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
                              (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))
 
 ;;; (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
 
        ;; 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)
                       (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))))))
 
   (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)
 
                            (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)
                                        ,(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
                                  (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.
                      `(%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
        #'(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)))
index 37fde27..a114b6d 100644 (file)
                                  (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)))))
 
         (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)))
index 444b3d6..37226a7 100644 (file)
     ;; 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))))
             (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)
               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)
      ,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
   '(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.
          (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
                        (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)
index 6f51770..b1d8865 100644 (file)
 (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)))
     (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))
 \f
 ;;;; handling of special forms
           (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))
index b874f10..8642df7 100644 (file)
@@ -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)
index 217fa19..1de7049 100644 (file)
@@ -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"