Fixing crossreferencing

db4
Slava Pestov 2008-02-06 12:09:42 -06:00
parent fbf83639d6
commit 548e6dce47
5 changed files with 94 additions and 18 deletions

View File

@ -250,3 +250,40 @@ DEFER: defer-redefine-test-2
[ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test
[ 2 1 ] [ defer-redefine-test-2 ] unit-test
! Cross-referencing issue
: compiled-xref-a ;
: compiled-xref-c ; inline
GENERIC: compiled-xref-b ( a -- b )
TUPLE: c-1 ;
M: c-1 compiled-xref-b compiled-xref-a compiled-xref-c ;
TUPLE: c-2 ;
M: c-2 compiled-xref-b drop 3 ;
[ t ] [
\ compiled-xref-a compiled-crossref get key?
] unit-test
[ ] [
[
\ compiled-xref-a forget
] with-compilation-unit
] unit-test
[ f ] [
\ compiled-xref-a compiled-crossref get key?
] unit-test
[ ] [
"IN: temporary : compiled-xref-c ; FORGET: { c-2 compiled-xref-b }" eval
] unit-test
[ f ] [
\ compiled-xref-a compiled-crossref get key?
] unit-test

View File

@ -203,3 +203,40 @@ TUPLE: redefinition-test-tuple ;
redefinition-test-generic ,
] { } make all-equal?
] unit-test
! Issues with forget
GENERIC: generic-forget-test-1
M: integer generic-forget-test-1 / ;
[ t ] [
\ / usage [ word? ] subset
[ word-name "generic-forget-test-1/integer" = ] contains?
] unit-test
[ ] [
[ \ generic-forget-test-1 forget ] with-compilation-unit
] unit-test
[ f ] [
\ / usage [ word? ] subset
[ word-name "generic-forget-test-1/integer" = ] contains?
] unit-test
GENERIC: generic-forget-test-2
M: sequence generic-forget-test-2 = ;
[ t ] [
\ = usage [ word? ] subset
[ word-name "generic-forget-test-2/sequence" = ] contains?
] unit-test
[ ] [
[ { sequence generic-forget-test-2 } forget ] with-compilation-unit
] unit-test
[ f ] [
\ = usage [ word? ] subset
[ word-name "generic-forget-test-2/sequence" = ] contains?
] unit-test

View File

@ -102,7 +102,9 @@ M: method-spec definition
first2 method dup [ method-def ] when ;
: forget-method ( class generic -- )
check-method [ delete-at ] with-methods ;
check-method
[ delete-at* ] with-methods
[ method-word forget ] [ drop ] if ;
M: method-spec forget* first2 forget-method ;
@ -145,5 +147,8 @@ M: generic subwords
swap "default-method" word-prop add
[ method-word ] map ;
M: generic forget-word
dup subwords [ forget-word ] each (forget-word) ;
: xref-generics ( -- )
all-words [ subwords [ xref ] each ] each ;

View File

@ -71,7 +71,9 @@ GENERIC# (quot-uses) 1 ( obj assoc -- )
M: object (quot-uses) 2drop ;
M: interned (quot-uses) dupd set-at ;
M: word (quot-uses)
>r dup "forgotten" word-prop
[ r> 2drop ] [ dup r> set-at ] if ;
: seq-uses ( seq assoc -- ) [ (quot-uses) ] curry each ;
@ -194,24 +196,17 @@ M: word where "loc" word-prop ;
M: word set-where swap "loc" set-word-prop ;
GENERIC: (forget-word) ( word -- )
GENERIC: forget-word ( word -- )
M: interned (forget-word)
dup word-name swap word-vocabulary vocab-words delete-at ;
: (forget-word) ( word -- )
dup "forgotten" word-prop [
dup delete-xref
dup delete-compiled-xref
dup word-name over word-vocabulary vocab-words delete-at
dup t "forgotten" set-word-prop
] unless drop ;
M: word (forget-word)
drop ;
: rename-word ( word newname newvocab -- )
pick (forget-word)
pick set-word-vocabulary
over set-word-name
reveal ;
: forget-word ( word -- )
dup delete-xref
dup delete-compiled-xref
(forget-word) ;
M: word forget-word (forget-word) ;
M: word forget* forget-word ;

View File

@ -32,6 +32,8 @@ $nl
{ { $snippet "with-" { $emphasis "foo" } } { "performs some kind of initialization and cleanup related to " { $snippet "foo" } ", usually in a new dynamic scope" } { $links with-scope with-stream } }
{ { $snippet "$" { $emphasis "foo" } } { "help markup" } { $links $heading $emphasis } }
}
{ $heading "Stack effect conventions" }
"Stack effect conventions are documented in " { $link "effect-declaration" } "."
{ $heading "Glossary of terms" }
"Common terminology and abbreviations used throughout Factor and its documentation:"
{ $table