From 93be6ce0b52433be08aa33830f40143f2cafa6a2 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Mon, 3 Dec 2012 00:46:56 +0100 Subject: [PATCH] GENERIC-FUNCTION-NAME is just a reader. The writer implements a different logic, acting via REINITIALIZE-INSTANCE. --- src/clos/hierarchy.lsp | 2 +- src/clos/kernel.lsp | 5 +++++ src/clos/method.lsp | 2 +- 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/clos/hierarchy.lsp b/src/clos/hierarchy.lsp index c63b8da16..4a6be3c76 100644 --- a/src/clos/hierarchy.lsp +++ b/src/clos/hierarchy.lsp @@ -108,7 +108,7 @@ (eval-when (:compile-toplevel :execute) (defparameter +standard-generic-function-slots+ '((name :initarg :name :initform nil - :accessor generic-function-name) + :reader generic-function-name) (spec-list :initform nil :accessor generic-function-spec-list) (method-combination :initarg :method-combination :initform (find-method-combination (class-prototype (find-class 'standard-generic-function)) 'standard nil) diff --git a/src/clos/kernel.lsp b/src/clos/kernel.lsp index 5ccebbe81..2d4c6bc70 100644 --- a/src/clos/kernel.lsp +++ b/src/clos/kernel.lsp @@ -112,6 +112,11 @@ (setf (fdefinition name) gfun) gfun))) +(defun (setf generic-function-name) (new-name gf) + (if *clos-booted* + (reinitialize-instance gf :name new-name) + (setf (slot-value gf 'name) new-name))) + (defun default-dispatch (generic-function) (cond ((null *clos-booted*) 'standard-generic-function) diff --git a/src/clos/method.lsp b/src/clos/method.lsp index f75cfb2c1..024014734 100644 --- a/src/clos/method.lsp +++ b/src/clos/method.lsp @@ -374,7 +374,7 @@ have disappeared." ;;; early version used during bootstrap (defun add-method (gf method) (with-early-accessors (+standard-method-slots+ +standard-generic-function-slots+ +standard-class-slots+) - (let* ((name (generic-function-name gf)) + (let* ((name (slot-value gf 'name)) (method-entry (assoc name *early-methods*))) (unless method-entry (setq method-entry (list name))