Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
83cde1c7
Commit
83cde1c7
authored
Jan 22, 2013
by
Dave Cooper
Browse files
removed conditional on trickle-down-slots gdl-basis definitions for gdl-slots
parent
ec8554f9
Changes
2
Hide whitespace changes
Inline
Side-by-side
gdl/base/common/genworks.lisp
View file @
83cde1c7
...
...
@@ -82,7 +82,7 @@
(
original-redefinition-warnings
#+
allegro
excl:*redefinition-warnings*
#+
lispworks
lw:*redefinition-action*
))
#+
(
or
allegro
lispworks
)
(
declare
(
ignore
original-redefinition-warnings
))
(
defun
begin-redefinitions-ok
()
#+
sbcl
(
declare
(
sb-ext:muffle-conditions
sb-ext:compiler-note
))
#+
(
or
allegro
lispworks
)
...
...
@@ -93,7 +93,7 @@
#+
(
or
allegro
lispworks
)
(
setq
#+
allegro
excl:*redefinition-warnings*
#+
lispworks
lw:*redefinition-action*
nil
#+
nil
original-redefinition-warnings
)))
original-redefinition-warnings
)))
#-
(
or
allegro
lispworks
cmu
sbcl
ccl
abcl
ecl
)
...
...
gdl/base/expanders/source/computed-slots.lisp
View file @
83cde1c7
...
...
@@ -125,21 +125,28 @@
;;
`
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
unless
(
fboundp
',
(
glisp:intern
(
symbol-name
slot
)
:gdl-trickle-downs
))
(
defgeneric
,
(
glisp:intern
(
symbol-name
slot
)
:gdl-trickle-downs
)
(
self
&rest
args
))))
(
defgeneric
,
(
glisp:intern
(
symbol-name
slot
)
:gdl-trickle-downs
)
(
,
self-arg
&rest
,
args-arg
)))
(
unless
(
fboundp
',
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
))
(
defgeneric
,
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
)
(
,
self-arg
&rest
,
args-arg
))))
`
(
unless
(
find-method
(
symbol-function
',
(
glisp:intern
(
symbol-name
slot
)
:gdl-trickle-downs
))
nil
(
list
(
find-class
'gdl-basis
))
nil
)
(
defmethod
,
(
glisp:intern
(
symbol-name
slot
)
:gdl-trickle-downs
)
((
,
self-arg
gdl-basis
)
&rest
,
args-arg
)
(
trickle-down-basis
,
self-arg
',slot
,
args-arg
)))
;;
;; FLAG -- (eval-when (:c- :l- :e) ...) for defgenerics for _all_ messages in header, then remove fboundp from conditional here.
;; FLAG -- we need to redefine the standard gdl-basis method here for trickle-down-slots,
;; figure out how to do it without the crude off/on of redefinition warnings.
;;
;; FLAG -- maybe don't remove, could have a trickle-down which is not otherwise declared as a message.
`
(
unless
nil
#+
nil
(
and
(
fboundp
',
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
))
(
find-method
(
symbol-function
',
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
))
nil
(
list
(
find-class
'gdl-basis
))
nil
))
(
defmethod
,
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
)
((
,
self-arg
gdl-basis
)
&rest
,
args-arg
)
(
chase-up-trickle-down
',
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
)
,
self-arg
,
args-arg
)))
`
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
glisp:begin-redefinitions-ok
))
`
(
defmethod
,
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
)
((
,
self-arg
gdl-basis
)
&rest
,
args-arg
)
(
chase-up-trickle-down
',
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
)
,
self-arg
,
args-arg
))
#+
nil
`
(
unless
(
find-method
(
symbol-function
',
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
))
nil
(
list
(
find-class
'gdl-basis
))
nil
)
(
defmethod
,
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
)
((
,
self-arg
gdl-basis
)
&rest
,
args-arg
)
(
chase-up-trickle-down
',
(
glisp:intern
(
symbol-name
slot
)
:gdl-slots
)
,
self-arg
,
args-arg
)))
`
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
glisp:end-redefinitions-ok
))
)))
slots
))
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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