fix forget memory leak

TODO.FACTOR.txt

@@ -26,13 +26,11 @@
 - test copy-into of a sequence into itself
 - vertical alignment of arrows -vs- outliner gadget
 - slice: if sequence or seq start is changed, abstraction violation
-- find* should test for index below 0
 
 + ui:
 
 - multi-part gradients
 - tabular output
-- completion
 - debugger should use outlining
 - support nested incremental layouts more efficiently
 - make-pane should not need world-theme

library/compiler/intrinsics.factor

@@ -138,6 +138,7 @@ namespaces sequences words ;
 : binary-jump ( node label op -- )
     pick binary-op-imm?
     [ binary-jump-imm ] [ binary-jump-reg ] if ;
+
 {
     { fixnum<= %jump-fixnum<= }
     { fixnum<  %jump-fixnum<  }

library/test/gadgets/line-editor.factor

@@ -16,7 +16,7 @@ USING: kernel line-editor namespaces sequences strings test ;
 [ 0 ] [ 0 0 10 10 (point-update) ] unit-test
 
 [ "Hello world" ] [
-    "Hello world" 0 "editor" get [ line-insert ] bind
+    "Hello world" 0 0 "editor" get [ line-replace ] bind
     "editor" get [ line-text get ] bind
 ] unit-test
 
@@ -27,7 +27,7 @@ USING: kernel line-editor namespaces sequences strings test ;
 
 [ "Hello, crazy world" ] [
     "editor" get [ 0 set-caret-pos ] bind
-    ", crazy" 5 "editor" get [ line-insert ] bind
+    ", crazy" 5 5 "editor" get [ line-replace ] bind
     "editor" get [ line-text get ] bind
 ] unit-test
 
@@ -35,7 +35,7 @@ USING: kernel line-editor namespaces sequences strings test ;
 
 [ "Hello, crazy world" ] [
     "editor" get [ 5 set-caret-pos "Hello world" line-text set ] bind
-    ", crazy" 5 "editor" get [ line-insert ] bind
+    ", crazy" 5 5 "editor" get [ line-replace ] bind
     "editor" get [ line-text get ] bind
 ] unit-test
 

library/test/generic.factor

@@ -132,7 +132,7 @@ TUPLE: another-one ;
 [ << another-one f >> ] [ <another-one> empty-method-test ] unit-test
 
 ! Test generic see and parsing
-[ "IN: temporary\nSYMBOL: bah\nUNION: bah fixnum alien ;\n" ]
+[ "IN: temporary SYMBOL: bah\nUNION: bah fixnum alien ;\n" ]
 [ [ \ bah see ] string-out ] unit-test
 
 ! Weird bug

library/test/prettyprint.factor

@@ -34,17 +34,17 @@ unit-test
 
 : foo dup * ; inline
 
-[ "IN: temporary\n: foo dup * ; inline\n" ]
+[ "IN: temporary : foo dup * ; inline\n" ]
 [ [ \ foo see ] string-out ] unit-test
 
 : bar ( x -- y ) 2 + ;
 
-[ "IN: temporary\n: bar ( x -- y ) 2 + ;\n" ] [ [ \ bar see ] string-out ] unit-test
+[ "IN: temporary : bar ( x -- y ) 2 + ;\n" ] [ [ \ bar see ] string-out ] unit-test
 
 : baz dup ;
 
 [ ] [ [ baz ] infer drop ] unit-test
-[ "IN: temporary\n: baz ( object -- object object ) dup ;\n" ]
+[ "IN: temporary : baz ( object -- object object ) dup ;\n" ]
 [ [ \ baz see ] string-out ] unit-test
 
 [ ] [ \ fixnum see ] unit-test

library/test/words.factor

@@ -1,5 +1,6 @@
 IN: temporary
-USING: generic kernel lists math namespaces test words sequences ;
+USING: generic hashtables kernel lists math namespaces sequences
+test words ;
 
 [ 4 ] [
     "poo" "scratchpad" create [ 2 2 + ] define-compound
@@ -74,6 +75,16 @@ FORGET: another-forgotten
 
 [ t ] [ \ car interned? ] unit-test
 
+! I forgot remove-crossref calls!
+: fee ;
+: foe fee ;
+: fie foe ;
+
+[ 0 ] [ \ fee crossref get hash hash-size ] unit-test
+[ t ] [ \ foe crossref get hash not ] unit-test
+
+FORGET: foe
+
 ! This has to be the last test in the file.
 : test-last ( -- ) ;
 word word-name "last-word-test" set

library/tools/describe.factor

@@ -62,8 +62,7 @@ M: word summary ( word -- )
     ] if ;
 
 : format-column ( list ? -- list )
-    >r [ unparse-short ] map
+    >r [ unparse-short ] map r> [
-    r> [
         [ 0 [ length max ] reduce ] keep
         [ swap CHAR: \s pad-right ] map-with
     ] unless ;

library/vocabularies.factor

@@ -72,6 +72,7 @@ SYMBOL: vocabularies
 : forget ( word -- )
     #! Remove a word definition.
     dup uncrossref
+    crossref get [ dupd remove-hash ] when*
     dup word-name swap word-vocabulary vocab remove-hash ;
 
 : interned? ( word -- ? )

library/words.factor

@@ -7,13 +7,16 @@ namespaces sequences strings vectors ;
 ! The basic word type. Words can be named and compared using
 ! identity. They hold a property map.
 
-: word-prop ( word name -- value ) swap word-props hash ;
+: word-prop ( word name -- value )
+    swap word-props hash ;
+
 : set-word-prop ( word value name -- )
     rot word-props pick [ set-hash ] [ remove-hash drop ] if ;
 
 ! Pointer to executable native code
 GENERIC: word-xt
 M: word word-xt ( w -- xt ) 7 integer-slot ;
+
 GENERIC: set-word-xt
 M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
 
@@ -41,21 +44,8 @@ SYMBOL: crossref
     #! Marks each word in the quotation as being a dependency
     #! of the word.
     crossref get [
-        dup uses [ (add-crossref) ] each-with
+        dup dup uses [ (add-crossref) ] each-with
-    ] [
+    ] when drop ;
-        drop
-    ] if ;
-
-: (remove-crossref) crossref get [ nest remove-hash ] bind ;
-
-: remove-crossref ( word -- )
-    #! Marks each word in the quotation as not being a
-    #! dependency of the word.
-    crossref get [
-        dup uses [ (remove-crossref) ] each-with
-    ] [
-        drop
-    ] if ;
 
 : usages ( word -- deps )
     #! List all usages of a word. This is a transitive closure,
@@ -67,10 +57,17 @@ SYMBOL: crossref
     crossref get ?hash dup [ hash-keys ] when ;
 
 GENERIC: (uncrossref) ( word -- )
+
 M: word (uncrossref) drop ;
 
+: remove-crossref ( usage user -- )
+    crossref get [ nest remove-hash ] bind ;
+
 : uncrossref ( word -- )
-    dup (uncrossref) usages [ (uncrossref) ] each ;
+    crossref get [
+        dup dup uses [ remove-crossref ] each-with
+        dup (uncrossref) dup usages [ (uncrossref) ] each
+    ] when drop ;
 
 ! The word primitive combined with the word def specify what the
 ! word does when invoked.
@@ -106,7 +103,7 @@ PREDICATE: word compound  ( obj -- ? ) word-primitive 1 = ;
 M: compound definer drop \ : ;
 
 : define-compound ( word def -- )
-    >r dup dup remove-crossref r> 1 swap define add-crossref ;
+    over >r 1 swap define r> add-crossref ;
 
 : reset-props ( word seq -- )
     [ f swap set-word-prop ] each-with ;