Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Vladimir Sedach
storage
Commits
41dd636b
Commit
41dd636b
authored
Dec 28, 2011
by
Stas Boukarev
Browse files
Better handling of slot redefinition.
parent
71abee59
Changes
2
Hide whitespace changes
Inline
Side-by-side
disk.lisp
View file @
41dd636b
...
...
@@ -452,11 +452,12 @@
(
let*
((
length
(
read-n-bytes
+sequence-length+
stream
))
(
vector
(
make-array
length
)))
(
loop
for
i
below
length
for
slot-d
=
(
slot-effective-definition
class
(
read-next-object
stream
))
do
(
setf
(
aref
vector
i
)
(
slot-effective-definition
class
(
read-next-object
stream
))))
(
setf
(
slots-to-store
class
)
vector
)
(
initialize-class-slots
class
:slots-to-store-only
t
))
(
cons
(
slot-definition-location
slot-d
)
(
slot-definition-initform
slot-d
))))
(
setf
(
slot-locations-and-initforms-read
class
)
vector
))
class
))
;;; identifiable
...
...
@@ -513,7 +514,7 @@
(
let*
((
instance
(
get-instance
(
read-n-bytes
+id-length+
stream
)))
(
class
(
class-of
instance
))
(
slots
(
slot-locations-and-initforms
class
)))
(
slots
(
slot-locations-and-initforms
-read
class
)))
(
declare
(
simple-vector
slots
))
(
loop
for
slot-id
=
(
read-n-bytes
1
stream
)
until
(
=
slot-id
+end+
)
...
...
mop.lisp
View file @
41dd636b
...
...
@@ -18,6 +18,9 @@
(
slot-locations-and-initforms
:initform
nil
:accessor
slot-locations-and-initforms
)
(
slot-locations-and-initforms-read
:initform
nil
:accessor
slot-locations-and-initforms-read
)
(
all-slot-locations-and-initforms
:initform
nil
:accessor
all-slot-locations-and-initforms
)
...
...
@@ -125,23 +128,25 @@
(
slot-definition-initform
slot-definition
)))
slot-definitions
))
(
defun
initialize-class-slots
(
class
&key
slots-to-store-only
)
(
setf
(
slot-locations-and-initforms
class
)
(
make-slots-cache
(
slots-to-store
class
)))
(
unless
slots-to-store-only
(
defun
initialize-class-slots
(
class
slots
)
(
let*
((
slots-to-store
(
coerce
(
remove-if-not
#'
store-slot-p
slots
)
'simple-vector
)))
(
setf
(
slots-to-store
class
)
slots-to-store
)
(
setf
(
slot-locations-and-initforms
class
)
(
make-slots-cache
slots-to-store
))
(
setf
(
all-slot-locations-and-initforms
class
)
(
make-slots-cache
(
class-slots
class
))
(
class-initforms
class
)
(
map
'vector
#'
slot-definition-initform
(
class-slots
class
)))))
(
defmethod
finalize-inheritance
:after
((
class
storable-class
))
(
let
((
slots
(
class-slots
class
)))
(
setf
(
slot-value
class
'slots-to-store
)
(
coerce
(
remove-if-not
#'
store-slot-p
slots
)
'simple-vector
))
(
initialize-class-slots
class
)
(
compute-search-key
class
slots
)
(
setf
(
class-relations
class
)
(
slots-with-relations
class
))))
(
make-slots-cache
slots
))
(
setf
(
class-initforms
class
)
(
map
'vector
#'
slot-definition-initform
slots
))
(
setf
(
class-relations
class
)
(
slots-with-relations
class
))
(
compute-search-key
class
slots
)))
(
defmethod
compute-slots
:around
((
class
storable-class
))
(
let
((
slots
(
call-next-method
)))
(
initialize-class-slots
class
slots
)
slots
))
(
defun
find-slot
(
slot-name
class
)
(
find
slot-name
(
class-slots
class
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment