Fix problem with word redefinition messing up crossref

slava 2006-05-25 05:29:45 +00:00
parent 60465ca9b3
commit 20facdea8f
4 changed files with 24 additions and 13 deletions

View File

@ -23,7 +23,6 @@
- code walker & exceptions -- test and debug problems - code walker & exceptions -- test and debug problems
- code walker and callbacks is broken? - code walker and callbacks is broken?
- look at xref issue
+ io: + io:

View File

@ -20,10 +20,8 @@ USING: hashtables kernel namespaces sequences ;
: (remove-vertex) ( vertex graph -- ) nest remove-hash ; : (remove-vertex) ( vertex graph -- ) nest remove-hash ;
: remove-vertex ( vertex edges graph -- ) : remove-vertex ( vertex edges graph -- )
[ [ dupd call [ nest remove-hash ] each-with ] if-graph ;
>r dup dup r> call [ nest remove-hash ] each-with inline
namespace remove-hash
] if-graph ; inline
: in-edges ( vertex graph -- seq ) : in-edges ( vertex graph -- seq )
?hash dup [ hash-keys ] when ; ?hash dup [ hash-keys ] when ;

View File

@ -85,12 +85,21 @@ FORGET: another-forgotten
FORGET: foe FORGET: foe
! This has to be the last test in the file.
: test-last ( -- ) ;
word word-name "last-word-test" set
[ "test-last" ] [ "last-word-test" get ] unit-test
! xref should not retain references to gensyms ! xref should not retain references to gensyms
gensym [ * ] define-compound gensym [ * ] define-compound
[ t ] [ \ * usage [ interned? not ] subset empty? ] unit-test [ t ] [ \ * usage [ interned? not ] subset empty? ] unit-test
DEFER: calls-a-gensym
\ calls-a-gensym gensym dup "x" set unit define-compound
[ f ] [ "x" get crossref get hash ] unit-test
! regression
GENERIC: freakish
: bar freakish ;
M: array freakish ;
[ t ] [ \ bar \ freakish usage member? ] unit-test
! This has to be the last test in the file.
: test-last ( -- ) ;
[ "test-last" ] [ word word-name ] unit-test

View File

@ -49,8 +49,12 @@ M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
SYMBOL: crossref SYMBOL: crossref
: xref-word ( word -- ) : xref-word ( word -- )
dup word-vocabulary dup word-vocabulary [
[ [ uses ] crossref get add-vertex ] [ drop ] if ; [ uses [ word-vocabulary ] subset ]
crossref get add-vertex
] [
drop
] if ;
: usage ( word -- seq ) crossref get in-edges ; : usage ( word -- seq ) crossref get in-edges ;
@ -141,6 +145,7 @@ SYMBOL: vocabularies
: forget ( word -- ) : forget ( word -- )
dup unxref-word dup unxref-word
crossref get [ dupd remove-hash ] when*
dup word-name swap word-vocabulary vocab remove-hash ; dup word-name swap word-vocabulary vocab remove-hash ;
: forget-vocab ( vocab -- ) : forget-vocab ( vocab -- )