From 548e6dce4774507eb289968268438c255028c054 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 6 Feb 2008 12:09:42 -0600
Subject: [PATCH] Fixing crossreferencing

---
 core/compiler/test/redefine.factor  | 37 +++++++++++++++++++++++++++++
 core/generic/generic-tests.factor   | 37 +++++++++++++++++++++++++++++
 core/generic/generic.factor         |  7 +++++-
 core/words/words.factor             | 29 ++++++++++------------
 extra/help/handbook/handbook.factor |  2 ++
 5 files changed, 94 insertions(+), 18 deletions(-)

diff --git a/core/compiler/test/redefine.factor b/core/compiler/test/redefine.factor
index 01dd27f8be..9bcdcdfcde 100755
--- a/core/compiler/test/redefine.factor
+++ b/core/compiler/test/redefine.factor
@@ -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
diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor
index f1e1ebd6d2..4de05aafd0 100755
--- a/core/generic/generic-tests.factor
+++ b/core/generic/generic-tests.factor
@@ -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
diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 453d72effb..53f47c09d5 100755
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -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 ;
diff --git a/core/words/words.factor b/core/words/words.factor
index 93b1185335..c2118598af 100755
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -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 ;
 
diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor
index 81e4bea7b3..d6b4ec7ffe 100755
--- a/extra/help/handbook/handbook.factor
+++ b/extra/help/handbook/handbook.factor
@@ -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