mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-02-05 15:10:40 -08:00
Code Issues Projects Releases Packages Wiki Activity

Merged STANDARD-INSTANCE-GET and STANDARD-INSTANCE-ACCESS.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-12-19 22:44:01 +01:00
parent 7a443b5278
commit 0f2688147d
7 changed files with 16 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/c/symbols_list.h
View file

@ -1668,7 +1668,7 @@ cl_symbols[] = {
{CLOS_ "FIND-METHOD-COMBINATION", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "FORWARD-REFERENCED-CLASS", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "FUNCALLABLE-STANDARD-CLASS", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "FUNCALLABLE-STANDARD-INSTANCE-ACCESS", CLOS_ORDINARY, si_instance_ref, 2, OBJNULL},
{CLOS_ "FUNCALLABLE-STANDARD-INSTANCE-ACCESS", CLOS_ORDINARY, ECL_NAME(clos_funcallable_standard_instance_access), 2, OBJNULL},
{CLOS_ "FUNCALLABLE-STANDARD-OBJECT", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "GENERIC-FUNCTION-DECLARATIONS", CLOS_ORDINARY, NULL, -1, OBJNULL},
@ -1713,7 +1713,7 @@ cl_symbols[] = {
{CLOS_ "STANDARD-ACCESSOR-METHOD", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "STANDARD-DIRECT-SLOT-DEFINITION", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "STANDARD-EFFECTIVE-SLOT-DEFINITION", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "STANDARD-INSTANCE-ACCESS", CLOS_ORDINARY, si_instance_ref, 2, OBJNULL},
{CLOS_ "STANDARD-INSTANCE-ACCESS", CLOS_ORDINARY, ECL_NAME(clos_standard_instance_access), 2, OBJNULL},
{CLOS_ "STANDARD-READER-METHOD", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "STANDARD-SLOT-DEFINITION", CLOS_ORDINARY, NULL, -1, OBJNULL},
{CLOS_ "STANDARD-WRITER-METHOD", CLOS_ORDINARY, NULL, -1, OBJNULL},

4
src/c/symbols_list2.h
View file

@ -1668,7 +1668,7 @@ cl_symbols[] = {
{CLOS_ "FIND-METHOD-COMBINATION",NULL},
{CLOS_ "FORWARD-REFERENCED-CLASS",NULL},
{CLOS_ "FUNCALLABLE-STANDARD-CLASS",NULL},
{CLOS_ "FUNCALLABLE-STANDARD-INSTANCE-ACCESS","si_instance_ref"},
{CLOS_ "FUNCALLABLE-STANDARD-INSTANCE-ACCESS","ECL_NAME(clos_funcallable_standard_instance_access)"},
{CLOS_ "FUNCALLABLE-STANDARD-OBJECT",NULL},
{CLOS_ "GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER",NULL},
{CLOS_ "GENERIC-FUNCTION-DECLARATIONS",NULL},
@ -1713,7 +1713,7 @@ cl_symbols[] = {
{CLOS_ "STANDARD-ACCESSOR-METHOD",NULL},
{CLOS_ "STANDARD-DIRECT-SLOT-DEFINITION",NULL},
{CLOS_ "STANDARD-EFFECTIVE-SLOT-DEFINITION",NULL},
{CLOS_ "STANDARD-INSTANCE-ACCESS","si_instance_ref"},
{CLOS_ "STANDARD-INSTANCE-ACCESS","ECL_NAME(clos_standard_instance_access)"},
{CLOS_ "STANDARD-READER-METHOD",NULL},
{CLOS_ "STANDARD-SLOT-DEFINITION",NULL},
{CLOS_ "STANDARD-WRITER-METHOD",NULL},

4
src/clos/slotvalue.lsp
View file

@ -28,14 +28,14 @@
(defmethod slot-value-using-class ((class std-class) self slotd)
(declare (ignore class))
(let* ((location (slot-definition-location slotd))
(value (standard-instance-get self location)))
(value (standard-instance-access self location)))
(if (si:sl-boundp value)
value
(values (slot-unbound class self (slot-definition-name slotd))))))
(defmethod slot-boundp-using-class ((class std-class) self slotd)
(declare (ignore class))
(si:sl-boundp (standard-instance-get self (slot-definition-location slotd))))
(si:sl-boundp (standard-instance-access self (slot-definition-location slotd))))
(defmethod (setf slot-value-using-class) (val (class std-class) self slotd)
(declare (ignore class))

6
src/clos/std-slot-value.lsp
View file

@ -163,7 +163,7 @@
;;; Specific functions for slot reading, writing, boundness checking, etc.
;;;
(defun standard-instance-get (instance location)
(defun standard-instance-access (instance location)
(with-early-accessors (+standard-class-slots+
+slot-definition-slots+)
(ensure-up-to-date-instance instance)
@ -198,7 +198,7 @@
(if location-table
(let ((location (gethash slot-name location-table nil)))
(if location
(let ((value (standard-instance-get self location)))
(let ((value (standard-instance-access self location)))
(if (si:sl-boundp value)
value
(values (slot-unbound class self slot-name))))
@ -220,7 +220,7 @@
(if location-table
(let ((location (gethash slot-name location-table nil)))
(if location
(si:sl-boundp (standard-instance-get self location))
(si:sl-boundp (standard-instance-access self location))
(values (slot-missing class self slot-name 'SLOT-BOUNDP))))
(let ((slotd (find slot-name (class-slots class) :key #'slot-definition-name)))
(if slotd

6
src/cmp/proclamations.lsp
View file

@ -290,8 +290,6 @@
;; Slot accessors:
; (proclamation unbound-slot-instance (condition) si::instance :predicate)
#+clos
(proclamation clos::standard-instance-get (ext:instance t) t)
#+clos
(proclamation clos::standard-instance-set (t ext:instance t) t)
#+clos
@ -1344,10 +1342,10 @@
#+clos
(proclamation si:sl-makunbound (t fixnum) t)
#+clos
(proclamation clos:standard-instance-access (standard-object fixnum) t :reader)
(proclamation clos:standard-instance-access (standard-object t) t :reader)
#+clos
(proclamation clos:funcallable-standard-instance-access
(clos:funcallable-standard-object fixnum)
(clos:funcallable-standard-object t)
t :reader)
#+clos
(proclamation associate-methods-to-gfun (generic-function *)

10
src/cmp/sysfun.lsp
View file

@ -839,16 +839,12 @@
#+clos
(def-inline si:sl-boundp :always (t) :bool "(#0)!=ECL_UNBOUND")
#+clos
(def-inline clos:standard-instance-access :always (t t) t "ecl_instance_ref((#0),ecl_to_size(#1))")
#+clos
(def-inline clos:standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))")
#+clos
(def-inline clos:standard-instance-access :unsafe (standard-object fixnum) t
"(#0)->instance.slots[#1]")
#+clos
(def-inline clos:funcallable-standard-instance-access :always (t t) t "ecl_instance_ref((#0),ecl_to_size(#1))")
#+clos
(def-inline clos:funcallable-standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))")
#+clos
@ -938,8 +934,8 @@
clos:std-compute-applicable-methods
clos:std-compute-effective-method
clos:compute-effective-method-function
;; standard-instance-access ; this function is a synonym for si:instance-ref
;; funcallable-standard-instance-access ; same for this one
standard-instance-access
;; funcallable-standard-instance-access alias for standard-instance-access
subclassp of-class-p
;; boot.lsp
slot-boundp
@ -1006,7 +1002,7 @@
,@'(;; defclass.lsp
clos::ensure-class
;; std-slot-value.lsp
clos::standard-instance-get
clos::standard-instance-access
clos::standard-instance-set
clos::find-slot-definition
;; combin.lsp

2
src/h/external.h
View file

@ -2159,6 +2159,8 @@ extern ECL_API cl_object clos_standard_instance_set _ECL_ARGS((cl_narg narg, cl_
/* std-slot-value */
extern ECL_API cl_object cl_slot_value(cl_object object, cl_object slot);
extern ECL_API cl_object clos_slot_value_set(cl_object value, cl_object instance, cl_object name);
extern ECL_API cl_object clos_standard_instance_access(cl_object object, cl_object location);
#define clos_funcallable_standard_instance_access clos_standard_instance_access
#endif