(call-next-method) now takes a method instead of a class and a generic
parent
f1b95c0038
commit
3e7afcac29
|
@ -90,8 +90,12 @@ IN: stack-checker.transforms
|
|||
\ spread [ spread>quot ] 1 define-transform
|
||||
|
||||
\ (call-next-method) [
|
||||
[ [ inlined-dependency depends-on ] bi@ ] [ next-method-quot ] 2bi
|
||||
] 2 define-transform
|
||||
[
|
||||
[ "method-class" word-prop ]
|
||||
[ "method-generic" word-prop ] bi
|
||||
[ inlined-dependency depends-on ] bi@
|
||||
] [ next-method-quot ] bi
|
||||
] 1 define-transform
|
||||
|
||||
! Constructors
|
||||
\ boa [
|
||||
|
|
|
@ -162,6 +162,6 @@ HELP: forget-methods
|
|||
{ sort-classes order } related-words
|
||||
|
||||
HELP: (call-next-method)
|
||||
{ $values { "class" class } { "generic" generic } }
|
||||
{ $values { "method" method-body } }
|
||||
{ $description "Low-level word implementing " { $link POSTPONE: call-next-method } "." }
|
||||
{ $notes "In most cases, " { $link POSTPONE: call-next-method } " should be used instead." } ;
|
||||
|
|
|
@ -49,12 +49,16 @@ GENERIC: effective-method ( generic -- method )
|
|||
|
||||
GENERIC: next-method-quot* ( class generic combination -- quot )
|
||||
|
||||
: next-method-quot ( class generic -- quot )
|
||||
: next-method-quot ( method -- quot )
|
||||
next-method-quot-cache get [
|
||||
dup "combination" word-prop next-method-quot*
|
||||
] 2cache ;
|
||||
[ "method-class" word-prop ]
|
||||
[
|
||||
"method-generic" word-prop
|
||||
dup "combination" word-prop
|
||||
] bi next-method-quot*
|
||||
] cache ;
|
||||
|
||||
: (call-next-method) ( class generic -- )
|
||||
: (call-next-method) ( method -- )
|
||||
next-method-quot call ;
|
||||
|
||||
TUPLE: check-method class generic ;
|
||||
|
|
|
@ -13,17 +13,10 @@ ERROR: not-in-a-method-error ;
|
|||
: CREATE-METHOD ( -- method )
|
||||
scan-word bootstrap-word scan-word create-method-in ;
|
||||
|
||||
SYMBOL: current-class
|
||||
SYMBOL: current-generic
|
||||
SYMBOL: current-method
|
||||
|
||||
: with-method-definition ( quot -- parsed )
|
||||
[
|
||||
[
|
||||
[ "method-class" word-prop current-class set ]
|
||||
[ "method-generic" word-prop current-generic set ]
|
||||
[ ] tri
|
||||
] dip call
|
||||
] with-scope ; inline
|
||||
: with-method-definition ( method quot -- )
|
||||
[ dup current-method ] dip with-variable ; inline
|
||||
|
||||
: (M:) ( method def -- )
|
||||
CREATE-METHOD [ parse-definition ] with-method-definition ;
|
||||
|
|
|
@ -202,13 +202,12 @@ IN: bootstrap.syntax
|
|||
] define-syntax
|
||||
|
||||
"call-next-method" [
|
||||
current-class get current-generic get
|
||||
2dup [ word? ] both? [
|
||||
[ literalize parsed ] bi@
|
||||
current-method get [
|
||||
literalize parsed
|
||||
\ (call-next-method) parsed
|
||||
] [
|
||||
not-in-a-method-error
|
||||
] if
|
||||
] if*
|
||||
] define-syntax
|
||||
|
||||
"initial:" "syntax" lookup define-symbol
|
||||
|
|
Loading…
Reference in New Issue