Another attempt at size reduction

db4
Slava Pestov 2008-11-28 01:08:16 -06:00
parent c8f227ccf7
commit 817510cdb9
5 changed files with 39 additions and 29 deletions

View File

@ -165,3 +165,19 @@ HELP: (call-next-method)
{ $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." } ;
HELP: no-next-method
{ $error-description "Thrown by " { $link POSTPONE: call-next-method } " if the current method is already the least specific method." }
{ $examples
"The following code throws this error:"
{ $code
"GENERIC: error-test ( object -- )"
""
"M: number error-test 3 + call-next-method ;"
""
"M: integer error-test recip call-next-method ;"
""
"123 error-test"
}
"This results in the method on " { $link integer } " being called, which then calls the method on " { $link number } ". The latter then calls " { $link POSTPONE: call-next-method } ", however there is no method less specific than the method on " { $link number } " and so an error is thrown."
} ;

View File

@ -58,8 +58,10 @@ GENERIC: next-method-quot* ( class generic combination -- quot )
] bi next-method-quot*
] cache ;
ERROR: no-next-method method ;
: (call-next-method) ( method -- )
next-method-quot call ;
dup next-method-quot [ call ] [ no-next-method ] ?if ;
TUPLE: check-method class generic ;

View File

@ -33,22 +33,6 @@ HELP: define-simple-generic
{ standard-combination hook-combination } related-words
HELP: no-next-method
{ $error-description "Thrown by " { $link POSTPONE: call-next-method } " if the current method is already the least specific method." }
{ $examples
"The following code throws this error:"
{ $code
"GENERIC: error-test ( object -- )"
""
"M: number error-test 3 + call-next-method ;"
""
"M: integer error-test recip call-next-method ;"
""
"123 error-test"
}
"This results in the method on " { $link integer } " being called, which then calls the method on " { $link number } ". The latter then calls " { $link POSTPONE: call-next-method } ", however there is no method less specific than the method on " { $link number } " and so an error is thrown."
} ;
HELP: inconsistent-next-method
{ $error-description "Thrown by " { $link POSTPONE: call-next-method } " if the values on the stack are not compatible with the current method." }
{ $examples

View File

@ -79,17 +79,15 @@ ERROR: no-method object generic ;
ERROR: inconsistent-next-method class generic ;
ERROR: no-next-method class generic ;
: single-next-method-quot ( class generic -- quot )
[
2dup next-method [
: single-next-method-quot ( class generic -- quot/f )
2dup next-method dup [
[
pick "predicate" word-prop %
1quotation ,
[ inconsistent-next-method ] 2curry ,
\ if ,
] [ [ no-next-method ] 2curry % ] if*
] [ ] make ;
] [ ] make
] [ 3drop f ] if ;
: single-effective-method ( obj word -- method )
[ [ order [ instance? ] with find-last nip ] keep method ]
@ -127,7 +125,8 @@ M: standard-combination method-declaration
M: standard-combination next-method-quot*
[
single-next-method-quot picker prepend
single-next-method-quot
dup [ picker prepend ] when
] with-standard ;
M: standard-generic effective-method
@ -142,9 +141,12 @@ PREDICATE: hook-generic < generic
: with-hook ( combination quot -- quot' )
0 (dispatch#) [
dip var>> [ get ] curry prepend
[ hook-combination ] dip with-variable
] with-variable ; inline
: prepend-hook-var ( quot -- quot' )
hook-combination get var>> [ get ] curry prepend ;
M: hook-combination dispatch# drop 0 ;
M: hook-combination method-declaration 2drop [ ] ;
@ -156,13 +158,18 @@ M: hook-generic effective-method
single-effective-method ;
M: hook-combination make-default-method
[ error-method ] with-hook ;
[ error-method prepend-hook-var ] with-hook ;
M: hook-combination perform-combination
[ drop ] [ [ single-combination ] with-hook ] 2bi define ;
[ drop ] [
[ single-combination prepend-hook-var ] with-hook
] 2bi define ;
M: hook-combination next-method-quot*
[ single-next-method-quot ] with-hook ;
[
single-next-method-quot
dup [ prepend-hook-var ] when
] with-hook ;
M: simple-generic definer drop \ GENERIC: f ;

View File

@ -0,0 +1 @@
slava@slava-pestovs-macbook-pro.local.14895