[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: si:allow-refinitions
Date: Thu, 19 Jul 90 13:47 CDT
From: dmitchell@BACKUS.trc.amoco.com (Donald H. Mitchell)
Why isn't si:allow-refinitions documented? What should we use instead (short
of patch files)?
Dunno.... Seems that this question should be directed at Symbolics, not SLUG.
However, I do have a modified version of SI:ALLOW-REDEFINITION that takes
an extra optional argument of a file (with version number). If the current
definition of the function came from that file, then your redefinition
proceeds without any hassle. However, if the function was defined elsewhere
(someone redefined it or Symbolics's version has changed and they may
have redefined it), they you get warned and queried whether you really want to
redefine the function. This warns you that you ought to look back at the
original source to the function and see if it has changed (and so you should
change your redefinition).
We use this for our customizations/bug-fixes to Symbolics code. When we
load the code into the next release of the system, we are reminded of everywhere
we have built upon their code.
Yes, this stuff has been sent off to Symbolics.
Btw, it is generally better to permanently ADVISE Symbolics's functions
rather than to redefine them.
CHECK-SOURCE-FILE-AND-VERSION is based upon code from Rich Cohen (MCC).
Our LIBRARY:SRI;ALLOW-REDEFINITION.LISP.5
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: SYSTEM-INTERNALS; Base: 10; Default-character-style: (:FIX :ROMAN :NORMAL) -*-
;;;1 Functions to allow specifying that we know we are redefining someone else's code
0;;;1 Call (SI:ALLOW-REDEFINITION
0;;;1 '(flavor:method neti:remote-terminal-flavor neti:telnet-terminal)
0;;;1 'DEFUN
0;;;1 "SYS:NETWORK2;1NETWORK-TERMINAL.LISP.1531")
0;;;1 To specify that you are redefining the method that is defined in SYS:NETWORK2;1NETWORK-TERMINAL.1531
0;;;1 If you try to load that code when there isn't such a definition, then you will get warned.
0;;;
;;;1 Call (SI:ALLOW-REDEFINITION-OF-FILE "SYS:NETWORK2;1NETWORK-TERMINAL.LISP.1531")
0;;;1 to specify that the file being loaded can redefine anything in that older file.
0;;;
;;;1 Since the source versions of the file available may be newer than the loaded version
0;;;1 of the file, we do not complain if the version number in ALLOW-REDEFINITION is *newer*
0;;;1 than the actual version of the file that was loaded. So, if the loaded version of
0;;;1 NETWORK-TERMINAL.LISP is 1530, then we don't complain. If it were 1540, we would
0;;;1 complain.
0;;;
;;;1 See below on how to define forms that call SI:ALLOW-REDEFINITION more than once (for, say, CP:DEFINE-COMMAND)
0;;;1 The use of ALLOW-REDEFINITION-INTERNAL is to avoid using Symbolics's code
0;;;1 Otherwise this code could not be freely distributed
0;;;1 Get the original definition of ALLOW-REDEFINITION
0(unless (fboundp 'allow-redefinition-internal)
(setf (cl:symbol-function 'allow-redefinition-internal)
(cl:symbol-function 'allow-redefinition)))
;;;1 Since we redefine Symbolics's function, we don't want it to complain now!
0(allow-redefinition-internal 'allow-redefinition)
;;;1 Don't complain about the redefinition of function FUNCTION-SPEC of type TYPE.
0;;;1 If SOURCE-FILE-AND-VERSION is given and doesn't match a definition of FUNCTION-SPEC,
0;;;1 do warn the user and let the redefinition warning happen.
0(defun 3ALLOW-REDEFINITION 0(function-spec &optional (type 'defun) source-file-and-version)
(if (get type 'allow-redefinition-function) ;2If there is a special form for this,
0 (funcall (get type 'allow-redefinition-function) ;2do it
0 function-spec type source-file-and-version)
(when ;2Otherwise just do the standard thing
0 (check-source-file-and-version function-spec type source-file-and-version)
(allow-redefinition-internal function-spec type))))
;;;1 CP:DEFINE-COMMAND is a macro that causes several definitions.
0;;;1 If you say (ALLOW-REDEFINITION 'CP:COM-SHOW-DIRECTORY 'CP:DEFINE-COMMAND ...)
0;;;1 Then this will allow the command to be redefined without multiple complaints
0(defun 3(CP:DEFINE-COMMAND ALLOW-REDEFINITION-FUNCTION)0 (command ignore source-file-and-version)
(when (check-source-file-and-version command 'cp:define-command source-file-and-version)
(allow-redefinition-internal command 'cp:define-command)
(allow-redefinition-internal command 'defun)
(allow-redefinition-internal `(cp::command-parser-function ,command) 'defun)))
(defun 3(FS:DEFINE-VMS-PARAMETER ALLOW-REDEFINITION-FUNCTION)0 (name ignore source-file-and-version)
(let ((mname (INTERN (STRING NAME) PKG-KEYWORD-PACKAGE)))
(when (check-source-file-and-version name 'fs:define-vms-parameter source-file-and-version)
(allow-redefinition-internal name 'fs:DEFINE-VMS-PARAMETER)
(allow-redefinition-internal (INTERN (STRING-APPEND "VMS-" NAME) "FS") 'DEFVAR)
(allow-redefinition-internal (INTERN (STRING-APPEND "VMS4-" NAME) "FS") 'DEFVAR)
(allow-redefinition-internal (INTERN (STRING-APPEND "VMS4.4-" NAME) "FS") 'DEFVAR)
(allow-redefinition-internal `(flavor:method ,MNAME fs:VMS3-PATHNAME-MIXIN) 'defun)
(allow-redefinition-internal `(flavor:method ,MNAME fs:VMS4-PATHNAME-MIXIN) 'defun)
(allow-redefinition-internal `(flavor:method ,MNAME fs:VMS4.4-PATHNAME-MIXIN) 'defun))))
(defun 3(ZWEI:DEFMINOR ALLOW-REDEFINITION-FUNCTION)0 (command ignore source-file-and-version)
(let ((non-com-name (intern (string command) (symbol-package command))))
(when
(check-source-file-and-version command 'zwei:defun source-file-and-version)
(allow-redefinition non-com-name 'defflavor)
(allow-redefinition non-com-name 'type)
(allow-redefinition `(flavor:method :mode-line-name ,non-com-name)
'defmethod)
(allow-redefinition `(flavor:method :mode-forms ,non-com-name)
'defmethod)
(allow-redefinition `(flavor:combined :mode-forms ,non-com-name)
'defmethod)
(allow-redefinition command 'zwei:defun))))
;;;1 Don't complain about redefinitions in the current file of functions originally
0;;;1 defined in the file OLD-FILE-AND-VERSION.
0(defun 3ALLOW-REDEFINITION-OF-FILE 0(old-file-and-version)
(setq old-file-and-version (fs:parse-pathname old-file-and-version))
(let* ((old-file (send old-file-and-version
:new-pathname :version nil
:type nil))
(actual-path-and-version (send old-file
:get :QFASL-SOURCE-FILE-UNIQUE-ID))
(new-pathname si:fdefine-file-pathname))
(if (null actual-path-and-version)
(compiler:warn (list :function nil :definition-type nil)
"File ~A claims to be redefining things in ~A which hasn't been loaded"
new-pathname old-file-and-version)
(if (> (send actual-path-and-version :version) (send old-file-and-version :version))
(compiler:warn (list :function nil :definition-type nil)
"File ~A expects to be redefining things from file ~A but~%~
the loaded version is really ~D. You may need to recheck your definitions."
new-pathname old-file-and-version (send actual-path-and-version :version))
(if new-pathname
(push old-file (send new-pathname :get :redefines-files))
(push old-file si:*files-redefined-by-nil*))))))
;;;1 This function sees if the function (of type TYPE) specified by FSPEC was
0;;;1 defined in the file SOURCE-FILE-AND-VERSION (a logical pathname).
0;;;1 If so, it returns T. If not, it issues a compiler warning and returns NIL
0(defun 3CHECK-SOURCE-FILE-AND-VERSION 0(fspec type source-file-and-version)
(if (null source-file-and-version)
t ;2If the user didn't specify a source-file-or-version, then let him redefine the function with impunity
0 (let (version source-file)
(setq source-file-and-version (fs:parse-pathname source-file-and-version))
(setq version (send source-file-and-version :version))
(setq source-file (send source-file-and-version :new-pathname :version nil))
(unless (typep source-file 'fs:logical-pathname)
(cl:error "File specification ~A to CHECK-SOURCE-FILE-AND-VERSION for function ~A should be a logical pathname"
source-file-and-version
fspec))
(unless (null (send source-file :type))
(setq source-file (send source-file :new-type nil)))
(let* ((logical-file-with-version (send source-file :get :QFASL-SOURCE-FILE-UNIQUE-ID)) ;2This has the version number
0 (source-info (function-spec-get fspec :source-file-name))
(source-files (if (not (listp source-info))
(if (eq type 'defun) (list source-info)
nil)
(cdr (cl:assoc type source-info :test #'equal)))))
(if (not (member source-file source-files))
(compiler:warn (list :function fspec :definition-type type)
"The source file is missing or changed. The redefinition expects the original~%~
definition to be in ~A but the function is not defined in it.~%~
You may need to recheck your redefinition."
source-file-and-version)
(if (> (send logical-file-with-version :version) version)
(compiler:warn (list :function fspec :definition-type type)
"The source file has changed. The redefinition expects the original~%~
definition to be in ~A but it is actually~%~
in version ~D. You may need to recheck your redefinition."
source-file-and-version (send logical-file-with-version :version))
(return-from check-source-file-and-version t)))) ;2All is ok
0 nil))) ;2Return nil to say the redefinition is not ok
0;;;1 Old definitions at SRI... Here for compatibility's sake
0(defmacro 3ALLOW-REDEFINITION-BUT-CHECK-SOURCE 0(function-spec function-type source-file version)
`(allow-redefinition ',function-spec ',function-type
(send (fs:parse-pathname ,source-file) :new-pathname :version ,version)))
(compiler:make-obsolete allow-redefinition-but-check-source
"Use ALLOW-REDEFINITION instead")
(defun 3ALLOW-REDEFINITION-OF-ALL-IN-FILE 0(old-file old-version)
(allow-redefinition-of-file (send (fs:parse-pathname old-file) :new-pathname :new-version old-version)))
(compiler:make-obsolete allow-redefinition-of-all-in-file
"Use ALLOW-REDEFINITION-OF-FILE instead")