;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:ZL -*-

;;; Copyright (c) 1988 by Robert W. Kerns.
;;; Permission is granted to distribute this freely, or to
;;; incorporate this in any commercial product, so long as this
;;; copyright notice remains intact.


;;; This may LOOK circular, but it's not.  It actually defines a function
;;; DEF-definition-spec-HANDLER-HANDLER and manually stores that into the
;;; table.  This is just for this one special case, to avoid circular
;;; dependencies.

(def-definition-spec-handler def-definition-spec-handler (spec-type)
  (valid-definition-spec (spec)
    (symbolp spec-type))
  (fdefinition () (gethash spec-type *definition-spec-handlers*))
  ((setf fdefinition) (new-function)
   (setf (gethash spec-type *definition-spec-handlers*) new-function)))


(setf (gethash 'def-definition-spec-handler *definition-spec-handlers*)
      #'def-definition-spec-handler-handler)

(def-definition-spec-handler symbol (function-name)
  (valid-definition-spec (spec)
    (symbolp function-name))
  (fdefinition () (symbol-function function-name))
  ((setf fdefinition) (new-function)
   (setf (symbol-function function-name) new-function))
  (documentation ()
   (documentation function-name 'function))
  ((setf documentation) (new-documentation)
   (setf (documentation function-name 'function) new-documentation)))



(def-definition-spec-handler :property (symbol property)
  (valid-definition-spec (spec)
     (symbolp symbol))
  (fdefinition ()
    (get symbol property))
  ((setf fdefinition) (new-function)
   (setf (get symbol property) new-function))
  ;; Why not have the following ones create the preceeding ones?
  ((compile fdefinition) (environment)
   (declare (ignore environment))
   `(get ',symbol ',property))
  ((compile (setf fdefinition)) (environment new-function)
   (declare (ignore environment))
   `(setf (get ',symbol ',property) ,new-function)))