/[cmucl]/src/pcl/defs.lisp
ViewVC logotype

Diff of /src/pcl/defs.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.15 by pw, Thu Mar 11 16:51:04 1999 UTC revision 1.16 by dtc, Sun Mar 14 01:14:13 1999 UTC
# Line 59  Line 59 
59    
60    
61  ;;;  ;;;
 ;;; This is like fdefinition on the Lispm.  If Common Lisp had something like  
 ;;; function specs I wouldn't need this.  On the other hand, I don't like the  
 ;;; way this really works so maybe function specs aren't really right either?  
 ;;;  
 ;;; I also don't understand the real implications of a Lisp-1 on this sort of  
 ;;; thing.  Certainly some of the lossage in all of this is because these  
 ;;; SPECs name global definitions.  
 ;;;  
 ;;; Note that this implementation is set up so that an implementation which  
 ;;; has a 'real' function spec mechanism can use that instead and in that way  
 ;;; get rid of setf generic function names.  
 ;;;  
 (defmacro parse-gspec (spec  
                        (non-setf-var . non-setf-case)  
                        (setf-var . setf-case))  
   (declare (indentation 1 1))  
   (declare (ignore setf-var setf-case))  
   (once-only (spec)  
     `(cond (t  
             (let ((,non-setf-var ,spec)) ,@non-setf-case)))))  
   
 ;;;  
62  ;;; If symbol names a function which is traced or advised, return the  ;;; If symbol names a function which is traced or advised, return the
63  ;;; unadvised, traced etc. definition.  This lets me get at the generic  ;;; unadvised, traced etc. definition.  This lets me get at the generic
64  ;;; function object even when it is traced.  ;;; function object even when it is traced.
65  ;;;  ;;;
66  (defun unencapsulated-fdefinition (symbol)  (declaim (inline gdefinition))
67    (defun gdefinition (symbol)
68    (fdefinition symbol))    (fdefinition symbol))
69    
70  ;;;  ;;;
71  ;;; If symbol names a function which is traced or advised, redefine  ;;; If symbol names a function which is traced or advised, redefine
72  ;;; the `real' definition without affecting the advise.  ;;; the `real' definition without affecting the advise.
73  ;;;  ;;;
74  (defun fdefine-carefully (name new-definition)  (defun (setf gdefinition) (new-definition name)
75    #+cmu (progn    #+cmu (progn
76            (c::%%defun name new-definition nil)            (c::%%defun name new-definition nil)
77            (c::note-name-defined name :function)            (c::note-name-defined name :function)
# Line 100  Line 79 
79    #-(or cmu)    #-(or cmu)
80    (setf (symbol-function name) new-definition))    (setf (symbol-function name) new-definition))
81    
 (defun gboundp (spec)  
   (parse-gspec spec  
     (name (fboundp name))  
     (name (fboundp (get-setf-function-name name)))))  
   
 (defun gmakunbound (spec)  
   (parse-gspec spec  
     (name (fmakunbound name))  
     (name (fmakunbound (get-setf-function-name name)))))  
   
 (defun gdefinition (spec)  
   (parse-gspec spec  
     (name (or (unencapsulated-fdefinition name)))  
     (name (unencapsulated-fdefinition (get-setf-function-name name)))))  
   
 (defun (setf gdefinition) (new-value spec)  
   (parse-gspec spec  
     (name (fdefine-carefully name new-value))  
     (name (fdefine-carefully (get-setf-function-name name) new-value))))  
82    
83    
84  (proclaim '(special *the-class-t*  (proclaim '(special *the-class-t*

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

  ViewVC Help
Powered by ViewVC 1.1.5