From 483c4b5cd18a90ccf2fb8ba39c7be2a8ef9bd6a3 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Tue, 4 Nov 2014 19:40:46 -0500 Subject: [PATCH] Make early class predicates (CLASSP etc) get source locations. --- src/pcl/braid.lisp | 14 ++++++++------ src/pcl/defs.lisp | 2 +- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 128c7d501..d87ac252e 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -509,11 +509,13 @@ ;;; FIXME: find a better name. (defun !bootstrap-class-predicates (early-p) - (let ((*early-p* early-p)) - (dolist (ecp *early-class-predicates*) + (let ((*early-p* early-p) + (source-loc (sb-c:source-location))) + (dolist (ecp *!early-class-predicates*) (let ((class-name (car ecp)) (predicate-name (cadr ecp))) - (make-class-predicate (find-class class-name) predicate-name))))) + (!make-class-predicate (find-class class-name) predicate-name + source-loc))))) (defun !bootstrap-built-in-classes () @@ -612,9 +614,9 @@ (pushnew 'ensure-deffoo-class sb-kernel::*defstruct-hooks*) (pushnew 'ensure-deffoo-class sb-kernel::*define-condition-hooks*) -;;; FIXME: only needed during bootstrap -(defun make-class-predicate (class name) - (let* ((gf (ensure-generic-function name :lambda-list '(object))) +(defun !make-class-predicate (class name source-location) + (let* ((gf (ensure-generic-function name :lambda-list '(object) + :definition-source source-location)) (mlist (if (eq **boot-state** 'complete) (early-gf-methods gf) (generic-function-methods gf)))) diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index 400c09337..719b56c24 100644 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -715,7 +715,7 @@ (defclass dependent-update-mixin (plist-mixin) ()) -(defparameter *early-class-predicates* +(defparameter *!early-class-predicates* '((specializer specializerp) (standard-specializer standard-specializer-p) (exact-class-specializer exact-class-specializer-p) -- 2.11.4.GIT