From 35ff77d30acfbf6b8632bb0dd38cf8a7d3060897 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Thu, 6 May 2004 14:36:47 +0000 Subject: [PATCH] Merge in the 19a changes containing Helmut Eller's implementation for source location for defvar and friends. --- bootfiles/18e/boot25.lisp | 77 +++++++++++++++++++++++++++++++++++++++ code/describe.lisp | 10 ++++- code/macros.lisp | 14 +++++-- compiler/globaldb.lisp | 7 +++- 4 files changed, 101 insertions(+), 7 deletions(-) create mode 100644 bootfiles/18e/boot25.lisp diff --git a/bootfiles/18e/boot25.lisp b/bootfiles/18e/boot25.lisp new file mode 100644 index 000000000..b3d64eb42 --- /dev/null +++ b/bootfiles/18e/boot25.lisp @@ -0,0 +1,77 @@ + +(setf lisp::*enable-package-locked-errors* nil) +(in-package :c) + +;;; Used to record the source-location of definitions. +;;; +(define-info-class source-location) +(define-info-type source-location defvar (or form-numbers null) nil) + + +(in-package :lisp) +;;; DEFCONSTANT -- Public +;;; +(defmacro defconstant (var val &optional doc) + "For defining global constants at top level. The DEFCONSTANT says that the + value is constant and may be compiled into code. If the variable already has + a value, and this is not equal to the init, an error is signalled. The third + argument is an optional documentation string for the variable." + `(progn + (eval-when (:compile-toplevel) + (c::do-defconstant-compile-time ',var ,val ',doc)) + (eval-when (:load-toplevel :execute) + (c::%%defconstant ',var ,val ',doc (c::source-location))))) + +(defun set-defvar-source-location (name source-location) + (setf (info :source-location :defvar name) source-location)) + +;;; %Defconstant, %%Defconstant -- Internal +;;; +;;; Like the other %mumbles except that we currently actually do something +;;; interesting at load time, namely checking if the constant is being +;;; redefined. +;;; +(defun c::%defconstant (name value doc) + (c::%%defconstant name value doc nil)) +;;; +(defun c::%%defconstant (name value doc source-location) + (when doc + (setf (documentation name 'variable) doc)) + (when (boundp name) + (unless (equalp (symbol-value name) value) + (cerror "Go ahead and change the value." + "Constant ~S being redefined." name))) + (setf (symbol-value name) value) + (setf (info variable kind name) :constant) + (clear-info variable constant-value name) + (set-defvar-source-location name source-location) + name) + + +(defmacro defvar (var &optional (val nil valp) (doc nil docp)) + "For defining global variables at top level. Declares the variable + SPECIAL and, optionally, initializes it. If the variable already has a + value, the old value is not clobbered. The third argument is an optional + documentation string for the variable." + `(progn + (declaim (special ,var)) + ,@(when valp + `((unless (boundp ',var) + (setq ,var ,val)))) + ,@(when docp + `((setf (documentation ',var 'variable) ',doc))) + (set-defvar-source-location ',var (c::source-location)) + ',var)) + +(defmacro defparameter (var val &optional (doc nil docp)) + "Defines a parameter that is not normally changed by the program, + but that may be changed without causing an error. Declares the + variable special and sets its value to VAL. The third argument is + an optional documentation string for the parameter." + `(progn + (declaim (special ,var)) + (setq ,var ,val) + ,@(when docp + `((setf (documentation ',var 'variable) ',doc))) + (set-defvar-source-location ',var (c::source-location)) + ',var)) diff --git a/code/describe.lisp b/code/describe.lisp index b2970c569..d9cb926af 100644 --- a/code/describe.lisp +++ b/code/describe.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.42 2003/03/26 17:15:22 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.43 2004/05/06 14:36:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -448,4 +448,10 @@ ((null plist) ()) (unless (member (car plist) *implementation-properties*) (format t "~&Its ~S property is ~S." (car plist) (cadr plist)) - (describe (cadr plist))))) + (describe (cadr plist)))) + + ;; Describe where it was defined. + (let ((locn (info :source-location :defvar x))) + (when locn + (format t "~&It is defined in:~&~A" (c::file-source-location-pathname locn))))) + diff --git a/code/macros.lisp b/code/macros.lisp index 41e5a7c67..b2e7f0666 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.98 2004/04/14 17:01:22 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.99 2004/05/06 14:36:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -387,7 +387,10 @@ (eval-when (:compile-toplevel) (c::do-defconstant-compile-time ',var ,val ',doc)) (eval-when (:load-toplevel :execute) - (c::%%defconstant ',var ,val ',doc)))) + (c::%%defconstant ',var ,val ',doc (c::source-location))))) + +(defun set-defvar-source-location (name source-location) + (setf (info :source-location :defvar name) source-location)) ;;; %Defconstant, %%Defconstant -- Internal ;;; @@ -396,9 +399,9 @@ ;;; redefined. ;;; (defun c::%defconstant (name value doc) - (c::%%defconstant name value doc)) + (c::%%defconstant name value doc nil)) ;;; -(defun c::%%defconstant (name value doc) +(defun c::%%defconstant (name value doc source-location) (when doc (setf (documentation name 'variable) doc)) (when (boundp name) @@ -408,6 +411,7 @@ (setf (symbol-value name) value) (setf (info variable kind name) :constant) (clear-info variable constant-value name) + (set-defvar-source-location name source-location) name) @@ -423,6 +427,7 @@ (setq ,var ,val)))) ,@(when docp `((setf (documentation ',var 'variable) ',doc))) + (set-defvar-source-location ',var (c::source-location)) ',var)) (defmacro defparameter (var val &optional (doc nil docp)) @@ -435,6 +440,7 @@ (setq ,var ,val) ,@(when docp `((setf (documentation ',var 'variable) ',doc))) + (set-defvar-source-location ',var (c::source-location)) ',var)) diff --git a/compiler/globaldb.lisp b/compiler/globaldb.lisp index f90add329..92c211405 100644 --- a/compiler/globaldb.lisp +++ b/compiler/globaldb.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.46 2003/10/05 11:41:21 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.47 2004/05/06 14:36:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1165,6 +1165,11 @@ (define-info-class random-documentation) (define-info-type random-documentation stuff list ()) +;;; Used to record the source-location of definitions. +;;; +(define-info-class source-location) +(define-info-type source-location defvar (or form-numbers null) nil) + ); defun other-info-init (declaim (freeze-type info-env)) -- GitLab