Bug fixes

core/classes/classes-tests.factor

@@ -166,6 +166,6 @@ GENERIC: method-forget-test
 TUPLE: method-forget-class ;
 M: method-forget-class method-forget-test ;
 
-[ f ] [ \ method-forget-test "methods" assoc-empty? ] unit-test
+[ f ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
 [ ] [ [ \ method-forget-class forget ] with-compilation-unit ] unit-test
-[ t ] [ \ method-forget-test "methods" assoc-empty? ] unit-test
+[ t ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test

core/classes/tuple/tuple-tests.factor

@@ -4,7 +4,7 @@ namespaces quotations sequences.private classes continuations
 generic.standard effects classes.tuple classes.tuple.private
 arrays vectors strings compiler.units accessors classes.algebra
 calendar prettyprint io.streams.string splitting inspector
-columns math.order ;
+columns math.order classes.private ;
 IN: classes.tuple.tests
 
 TUPLE: rect x y w h ;
@@ -543,6 +543,7 @@ TUPLE: another-forget-accessors-test ;
 ! Missing error check
 [ "IN: classes.tuple.tests USE: words TUPLE: wrong-superclass < word ;" eval ] must-fail
 
+! Class forget messyness
 TUPLE: subclass-forget-test ;
 
 TUPLE: subclass-forget-test-1 < subclass-forget-test ;
@@ -551,6 +552,14 @@ TUPLE: subclass-forget-test-3 < subclass-forget-test-2 ;
 
 [ ] [ "IN: classes.tuple.tests FORGET: subclass-forget-test" eval ] unit-test
 
+[ H{ { subclass-forget-test-2 subclass-forget-test-2 } } ]
+[ subclass-forget-test-2 class-usages ]
+unit-test
+
+[ H{ { subclass-forget-test-3 subclass-forget-test-3 } } ]
+[ subclass-forget-test-3 class-usages ]
+unit-test
+
 [ f ] [ subclass-forget-test-1 tuple-class? ] unit-test
 [ f ] [ subclass-forget-test-2 tuple-class? ] unit-test
 [ subclass-forget-test-3 new ] must-fail

core/classes/tuple/tuple.factor

@@ -226,12 +226,6 @@ M: tuple-class reset-class
         } reset-props
     ] bi ;
 
-: reset-tuple-class ( class -- )
-    [ [ reset-class ] [ update-map- ] bi ] each-subclass ;
-
-M: tuple-class forget*
-    [ reset-tuple-class ] [ call-next-method ] bi ;
-
 M: tuple-class rank-class drop 0 ;
 
 M: tuple clone

core/compiler/units/units.factor

@@ -83,7 +83,14 @@ SYMBOL: update-tuples-hook
     call-recompile-hook
     call-update-tuples-hook
     dup [ drop compiled-crossref? ] assoc-contains? modify-code-heap
-    updated-definitions notify-definition-observers ;
+     ;
+
+: with-nested-compilation-unit ( quot -- )
+    [
+        H{ } clone changed-definitions set
+        H{ } clone outdated-tuples set
+        [ finish-compilation-unit ] [ ] cleanup
+    ] with-scope ; inline
 
 : with-compilation-unit ( quot -- )
     [
@@ -92,8 +99,11 @@ SYMBOL: update-tuples-hook
         H{ } clone outdated-tuples set
         <definitions> new-definitions set
         <definitions> old-definitions set
-        [ finish-compilation-unit ]
+        [
-        [ ] cleanup
+            finish-compilation-unit
+            updated-definitions
+            notify-definition-observers
+        ] [ ] cleanup
     ] with-scope ; inline
 
 : compile-call ( quot -- )

core/generic/generic.factor

@@ -147,12 +147,16 @@ M: method-body forget*
     [ implementors ] [ [ swap 2array ] curry ] bi map forget-all ;
 
 M: class forget* ( class -- )
-    {
+    [
-        [ forget-methods ]
+        class-usages [
-        [ update-map- ]
+            drop
-        [ reset-class ]
+            [ forget-methods ]
-        [ call-next-method ]
+            [ update-map- ]
-    } cleave ;
+            [ reset-class ]
+            tri
+        ] assoc-each
+    ]
+    [ call-next-method ] bi ;
 
 M: assoc update-methods ( assoc -- )
     implementors* [ make-generic ] each ;

core/parser/parser-tests.factor

@@ -461,10 +461,10 @@ must-fail-with
     "methods" word-prop assoc-size
 ] unit-test
 
-[ [ ] ] [
+[ ] [
     2 [
         "IN: parser.tests DEFER: twice-fails FORGET: twice-fails MIXIN: twice-fails"
-        <string-reader> "twice-fails-test" parse-stream
+        <string-reader> "twice-fails-test" parse-stream drop
     ] times
 ] unit-test
 

core/parser/parser.factor

@@ -357,10 +357,9 @@ M: staging-violation summary
     "A parsing word cannot be used in the same file it is defined in." ;
 
 : execute-parsing ( word -- )
-    new-definitions get [
+    [ changed-definitions get key? [ staging-violation ] when ]
-        dupd first key? [ staging-violation ] when
+    [ execute ]
-    ] when*
+    bi ;
-    execute ;
 
 : parse-step ( accum end -- accum ? )
     scan-word {

core/sequences/sequences-tests.factor

@@ -215,12 +215,6 @@ unit-test
     3 V{ 1 2 3 4 5 6 } clone [ delete-nth ] keep
 ] unit-test
 
-[ V{ 1 2 3 } ]
-[ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test
-
-[ V{ 1 2 3 } ]
-[ 3 V{ 1 3 2 } clone [ adjoin ] keep ] unit-test
-
 ! erg's random tester found this one
 [ SBUF" 12341234" ] [
     9 <sbuf> dup "1234" swap push-all dup dup swap push-all

core/sets/sets-tests.factor

@@ -15,3 +15,9 @@ IN: sets.tests
 
 [ V{ } ] [ { } { } union ] unit-test
 [ V{ 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test
+
+[ V{ 1 2 3 } ]
+[ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test
+
+[ V{ 1 2 3 } ]
+[ 3 V{ 1 3 2 } clone [ adjoin ] keep ] unit-test

core/syntax/syntax.factor

@@ -101,7 +101,7 @@ IN: bootstrap.syntax
 
     "DEFER:" [
         scan in get create
-        dup old-definitions get first delete-at
+        dup old-definitions get [ delete-at ] with each
         set-word
     ] define-syntax
 
@@ -189,8 +189,9 @@ IN: bootstrap.syntax
     "MAIN:" [ scan-word in get vocab set-vocab-main ] define-syntax
 
     "<<" [
-        [ \ >> parse-until >quotation ] with-compilation-unit
+        [
-        call
+            \ >> parse-until >quotation
+        ] with-nested-compilation-unit call
     ] define-syntax
 
     "call-next-method" [

core/words/words.factor

@@ -175,7 +175,9 @@ PRIVATE>
 : define-symbol ( word -- )
     dup [ ] curry define-inline ;
 
-: reset-word ( word -- )
+GENERIC: reset-word ( word -- )
+
+M: word reset-word
     {
         "unannotated-def"
         "parsing" "inline" "foldable" "flushable"