(call-next-method) now takes a method instead of a class and a generic

db4
Slava Pestov 2008-11-22 19:57:25 -06:00
parent f1b95c0038
commit 3e7afcac29
5 changed files with 21 additions and 21 deletions

View File

@ -90,8 +90,12 @@ IN: stack-checker.transforms
\ spread [ spread>quot ] 1 define-transform \ spread [ spread>quot ] 1 define-transform
\ (call-next-method) [ \ (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 ! Constructors
\ boa [ \ boa [

View File

@ -162,6 +162,6 @@ HELP: forget-methods
{ sort-classes order } related-words { sort-classes order } related-words
HELP: (call-next-method) HELP: (call-next-method)
{ $values { "class" class } { "generic" generic } } { $values { "method" method-body } }
{ $description "Low-level word implementing " { $link POSTPONE: call-next-method } "." } { $description "Low-level word implementing " { $link POSTPONE: call-next-method } "." }
{ $notes "In most cases, " { $link POSTPONE: call-next-method } " should be used instead." } ; { $notes "In most cases, " { $link POSTPONE: call-next-method } " should be used instead." } ;

View File

@ -49,12 +49,16 @@ GENERIC: effective-method ( generic -- method )
GENERIC: next-method-quot* ( class generic combination -- quot ) GENERIC: next-method-quot* ( class generic combination -- quot )
: next-method-quot ( class generic -- quot ) : next-method-quot ( method -- quot )
next-method-quot-cache get [ next-method-quot-cache get [
dup "combination" word-prop next-method-quot* [ "method-class" word-prop ]
] 2cache ; [
"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 ; next-method-quot call ;
TUPLE: check-method class generic ; TUPLE: check-method class generic ;

View File

@ -13,17 +13,10 @@ ERROR: not-in-a-method-error ;
: CREATE-METHOD ( -- method ) : CREATE-METHOD ( -- method )
scan-word bootstrap-word scan-word create-method-in ; scan-word bootstrap-word scan-word create-method-in ;
SYMBOL: current-class SYMBOL: current-method
SYMBOL: current-generic
: with-method-definition ( quot -- parsed ) : with-method-definition ( method quot -- )
[ [ dup current-method ] dip with-variable ; inline
[
[ "method-class" word-prop current-class set ]
[ "method-generic" word-prop current-generic set ]
[ ] tri
] dip call
] with-scope ; inline
: (M:) ( method def -- ) : (M:) ( method def -- )
CREATE-METHOD [ parse-definition ] with-method-definition ; CREATE-METHOD [ parse-definition ] with-method-definition ;

View File

@ -202,13 +202,12 @@ IN: bootstrap.syntax
] define-syntax ] define-syntax
"call-next-method" [ "call-next-method" [
current-class get current-generic get current-method get [
2dup [ word? ] both? [ literalize parsed
[ literalize parsed ] bi@
\ (call-next-method) parsed \ (call-next-method) parsed
] [ ] [
not-in-a-method-error not-in-a-method-error
] if ] if*
] define-syntax ] define-syntax
"initial:" "syntax" lookup define-symbol "initial:" "syntax" lookup define-symbol