Use call-next-method
parent
88092f2c2a
commit
16377be935
|
@ -207,8 +207,8 @@ M: tuple-class define-tuple-class
|
|||
M: tuple-class reset-class
|
||||
[
|
||||
dup "slot-names" word-prop [
|
||||
[ reader-word forget-method ]
|
||||
[ writer-word forget-method ] 2bi
|
||||
[ reader-word method forget ]
|
||||
[ writer-word method forget ] 2bi
|
||||
] with each
|
||||
] [
|
||||
{
|
||||
|
|
|
@ -106,14 +106,6 @@ M: method-spec definer
|
|||
M: method-spec definition
|
||||
first2 method definition ;
|
||||
|
||||
: forget-method ( class generic -- )
|
||||
dup generic? [
|
||||
[ delete-at* ] with-methods
|
||||
[ forget-word ] [ drop ] if
|
||||
] [
|
||||
2drop
|
||||
] if ;
|
||||
|
||||
M: method-spec forget*
|
||||
first2 method forget* ;
|
||||
|
||||
|
@ -123,9 +115,12 @@ M: method-body definer
|
|||
M: method-body forget*
|
||||
dup "forgotten" word-prop [ drop ] [
|
||||
[
|
||||
[ "method-class" word-prop ]
|
||||
[ "method-class" word-prop ]
|
||||
[ "method-generic" word-prop ] bi
|
||||
forget-method
|
||||
dup generic? [
|
||||
[ delete-at* ] with-methods
|
||||
[ call-next-method ] [ drop ] if
|
||||
] [ 2drop ] if
|
||||
]
|
||||
[ t "forgotten" set-word-prop ] bi
|
||||
] if ;
|
||||
|
@ -145,7 +140,7 @@ M: method-body forget*
|
|||
M: class forget* ( class -- )
|
||||
[ forget-methods ]
|
||||
[ update-map- ]
|
||||
[ forget-word ]
|
||||
[ call-next-method ]
|
||||
tri ;
|
||||
|
||||
M: assoc update-methods ( assoc -- )
|
||||
|
@ -169,8 +164,8 @@ M: generic subwords
|
|||
tri
|
||||
] { } make ;
|
||||
|
||||
M: generic forget-word
|
||||
[ subwords forget-all ] [ (forget-word) ] bi ;
|
||||
M: generic forget*
|
||||
[ subwords forget-all ] [ call-next-method ] bi ;
|
||||
|
||||
: xref-generics ( -- )
|
||||
all-words [ subwords [ xref ] each ] each ;
|
||||
|
|
|
@ -324,11 +324,7 @@ HELP: constructor-word
|
|||
{ $description "Creates a new word, surrounding " { $snippet "name" } " in angle brackets." }
|
||||
{ $examples { $example "USING: prettyprint words ;" "\"salmon\" \"scratchpad\" constructor-word ." "<salmon>" } } ;
|
||||
|
||||
HELP: forget-word
|
||||
{ $values { "word" word } }
|
||||
{ $description "Removes a word from its vocabulary. User code should call " { $link forget } " instead, since it also does the right thing when forgetting class words." } ;
|
||||
|
||||
{ POSTPONE: FORGET: forget forget-word forget-vocab } related-words
|
||||
{ POSTPONE: FORGET: forget forget* forget-vocab } related-words
|
||||
|
||||
HELP: target-word
|
||||
{ $values { "word" word } { "target" word } }
|
||||
|
|
|
@ -212,9 +212,7 @@ M: word where "loc" word-prop ;
|
|||
|
||||
M: word set-where swap "loc" set-word-prop ;
|
||||
|
||||
GENERIC: forget-word ( word -- )
|
||||
|
||||
: (forget-word) ( word -- )
|
||||
M: word forget*
|
||||
dup "forgotten" word-prop [
|
||||
dup delete-xref
|
||||
dup delete-compiled-xref
|
||||
|
@ -222,10 +220,6 @@ GENERIC: forget-word ( word -- )
|
|||
dup t "forgotten" set-word-prop
|
||||
] unless drop ;
|
||||
|
||||
M: word forget-word (forget-word) ;
|
||||
|
||||
M: word forget* forget-word ;
|
||||
|
||||
M: word hashcode*
|
||||
nip 1 slot { fixnum } declare ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue