Forgetting a definition removes compile error

Notify definition observers with nested compilation units

diff --git a/basis/compiler/errors/errors.factor b/basis/compiler/errors/errors.factor
index cb205e13b2639b7325a5fb79897dc54262b31d42..e3174470fbc68f002b2fe8b5947c51db789e3462 100644 (file)
--- a/basis/compiler/errors/errors.factor
+++ b/basis/compiler/errors/errors.factor
@@ -25,6 +25,7 @@ T{ error-type
    { plural "compiler errors" }
    { icon "vocab:ui/tools/error-list/icons/compiler-error.tiff" }
    { quot [ +compiler-error+ errors-of-type values ] }
+   { forget-quot [ compiler-errors get delete-at ] }
 } define-error-type
 
 T{ error-type
@@ -33,6 +34,7 @@ T{ error-type
    { plural "compiler warnings" }
    { icon "vocab:ui/tools/error-list/icons/compiler-warning.tiff" }
    { quot [ +compiler-warning+ errors-of-type values ] }
+   { forget-quot [ compiler-errors get delete-at ] }
 } define-error-type
 
 T{ error-type
@@ -41,6 +43,7 @@ T{ error-type
    { plural "linkage errors" }
    { icon "vocab:ui/tools/error-list/icons/linkage-error.tiff" }
    { quot [ +linkage-error+ errors-of-type values ] }
+   { forget-quot [ compiler-errors get delete-at ] }
 } define-error-type
 
 : <compiler-error> ( error word -- compiler-error )
@@ -48,8 +51,7 @@ T{ error-type
 
 : compiler-error ( error word -- )
     compiler-errors get-global pick
-    [ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if
-    notify-error-observers ;
+    [ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if ;
 
 : compiler-errors. ( type -- )
     errors-of-type values errors. ;

diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index bcb9411d3c5b7bef3fc42ad059c883ba82c02595..49ec534e8fa59c9bc0f27219235a8e9934394628 100644 (file)
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -268,15 +268,6 @@ M: duplicate-slot-names summary
 M: invalid-slot-name summary
     drop "Invalid slot name" ;
 
-M: source-file-error summary
-    error>> summary ;
-
-M: source-file-error compute-restarts
-    error>> compute-restarts ;
-
-M: source-file-error error-help
-    error>> error-help ;
-
 M: not-in-a-method-error summary
     drop "call-next-method can only be called in a method definition" ;
 
@@ -304,21 +295,6 @@ M: lexer-error compute-restarts
 M: lexer-error error-help
     error>> error-help ;
 
-M: source-file-error error.
-    [
-        [
-            [
-                [ file>> [ % ": " % ] when* ]
-                [ line#>> [ # ": " % ] when* ] bi
-            ] "" make
-        ] [
-            [
-                presented set
-                bold font-style set
-            ] H{ } make-assoc
-        ] bi format
-    ] [ error>> error. ] bi ;
-
 M: bad-effect summary
     drop "Bad stack effect declaration" ;
 

diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor
index 0c3c6d232db7990cb9e4df515f8fdfe61ad69b4c..42f29bc8b7a7a9d9113f8006cbaaa07de5fae337 100755 (executable)
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@@ -21,6 +21,7 @@ T{ error-type
    { plural "help lint failures" }
    { icon "vocab:ui/tools/error-list/icons/help-lint-error.tiff" }
    { quot [ lint-failures get values ] }
+   { forget-quot [ lint-failures get delete-at ] }
 } define-error-type
 
 M: help-lint-error error-type drop +help-lint-failure+ ;

diff --git a/basis/tools/errors/errors.factor b/basis/tools/errors/errors.factor
index 6cf60287d1b29c87c2cd7b1edf0c577ecb834ba1..a8708fd229d004d14b049f08086fc97ff5f85dbf 100644 (file)
--- a/basis/tools/errors/errors.factor
+++ b/basis/tools/errors/errors.factor
@@ -1,11 +1,36 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs debugger io kernel sequences source-files.errors ;
+USING: assocs debugger io kernel sequences source-files.errors
+summary accessors continuations make math.parser io.styles namespaces ;
 IN: tools.errors
 
 #! Tools for source-files.errors. Used by tools.tests and others
 #! for error reporting
 
+M: source-file-error summary
+    error>> summary ;
+
+M: source-file-error compute-restarts
+    error>> compute-restarts ;
+
+M: source-file-error error-help
+    error>> error-help ;
+
+M: source-file-error error.
+    [
+        [
+            [
+                [ file>> [ % ": " % ] when* ]
+                [ line#>> [ # "\n" % ] when* ] bi
+            ] "" make
+        ] [
+            [
+                presented set
+                bold font-style set
+            ] H{ } make-assoc
+        ] bi format
+    ] [ error>> error. ] bi ;
+
 : errors. ( errors -- )
     group-by-source-file sort-errors
     [

diff --git a/core/compiler/units/units-tests.factor b/core/compiler/units/units-tests.factor
index 6545a456046d4f73429a1da3c6e62b15d08dec48..464e17025d7b194373f236e1b9d9eb992d520de7 100644 (file)
--- a/core/compiler/units/units-tests.factor
+++ b/core/compiler/units/units-tests.factor
@@ -1,5 +1,5 @@
 USING: definitions compiler.units tools.test arrays sequences words kernel
-accessors namespaces fry ;
+accessors namespaces fry eval ;
 IN: compiler.units.tests
 
 [ [ [ ] define-temp ] with-compilation-unit ] must-infer
@@ -45,4 +45,17 @@ M: observer definitions-changed 2drop global [ counter inc ] bind ;
 
 [ ] with-compilation-unit
 
-[ 1 ] [ counter get-global ] unit-test
\ No newline at end of file
+[ 1 ] [ counter get-global ] unit-test
+
+observer remove-definition-observer
+
+! Notify observers with nested compilation units
+observer add-definition-observer
+
+0 counter set-global
+
+DEFER: nesting-test
+
+[ ] [ "IN: compiler.units.tests << : nesting-test ( -- ) ; >>" eval ] unit-test
+
+observer remove-definition-observer
\ No newline at end of file

diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index 88772caea08358062d5a155afdcf67aadcac56bc..a278bf0d5ecf4a90f38624a3bab0bfe3ff2f704a 100644 (file)
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays kernel continuations assocs namespaces
 sequences words vocabs definitions hashtables init sets
 math math.order classes classes.algebra classes.tuple
-classes.tuple.private generic ;
+classes.tuple.private generic source-files.errors ;
 IN: compiler.units
 
 SYMBOL: old-definitions
@@ -132,17 +132,20 @@ GENERIC: definitions-changed ( assoc obj -- )
     changed-generics get compiled-generic-usages
     append assoc-combine keys ;
 
-: unxref-forgotten-definitions ( -- )
-    forgotten-definitions get
-    keys [ word? ] filter
-    [ delete-compiled-xref ] each ;
+: process-forgotten-definitions ( -- )
+    forgotten-definitions get keys
+    [ [ word? ] filter [ delete-compiled-xref ] each ]
+    [ [ delete-definition-errors ] each ]
+    bi ;
 
 : finish-compilation-unit ( -- )
     remake-generics
     to-recompile recompile
     update-tuples
-    unxref-forgotten-definitions
-    modify-code-heap ;
+    process-forgotten-definitions
+    modify-code-heap
+    updated-definitions notify-definition-observers
+    notify-error-observers ;
 
 : with-nested-compilation-unit ( quot -- )
     [
@@ -166,9 +169,5 @@ GENERIC: definitions-changed ( assoc obj -- )
         H{ } clone new-classes set
         <definitions> new-definitions set
         <definitions> old-definitions set
-        [
-            finish-compilation-unit
-            updated-definitions
-            notify-definition-observers
-        ] [ ] cleanup
+        [ finish-compilation-unit ] [ ] cleanup
     ] with-scope ; inline

diff --git a/core/source-files/errors/errors-tests.factor b/core/source-files/errors/errors-tests.factor
new file mode 100644 (file)
index 0000000..f13790f
--- /dev/null
+++ b/core/source-files/errors/errors-tests.factor
@@ -0,0 +1,10 @@
+USING: assocs compiler.errors compiler.units definitions
+namespaces source-files.errors tools.test words ;
+IN: source-files.errors.tests
+
+DEFER: forget-test
+
+[ ] [ [ \ forget-test [ 1 ] (( -- )) define-declared ] with-compilation-unit ] unit-test
+[ t ] [ \ forget-test compiler-errors get key? ] unit-test
+[ ] [ [ \ forget-test forget ] with-compilation-unit ] unit-test
+[ f ] [ \ forget-test compiler-errors get key? ] unit-test
\ No newline at end of file

diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor
index ee7feca1b775bac094cf397787646d211e13e0d3..e179c99913aa5f9ac370f97a41092b62c153eb14 100644 (file)
--- a/core/source-files/errors/errors.factor
+++ b/core/source-files/errors/errors.factor
@@ -12,7 +12,7 @@ TUPLE: source-file-error error asset file line# ;
 : group-by-source-file ( errors -- assoc )
     H{ } clone [ [ push-at ] curry [ dup file>> ] prepose each ] keep ;
 
-TUPLE: error-type type word plural icon quot ;
+TUPLE: error-type type word plural icon quot forget-quot ;
 
 GENERIC: error-type ( error -- type )
 
@@ -68,4 +68,10 @@ SYMBOL: error-observers
         [ swap file>> = ] [ swap error-type = ]
         bi-curry* bi and not
     ] 2curry filter-here
-    notify-error-observers ;
\ No newline at end of file
+    notify-error-observers ;
+
+: delete-definition-errors ( definition -- )
+    error-types get [
+        second forget-quot>> dup
+        [ call( definition -- ) ] [ 2drop ] if
+    ] with each ;
\ No newline at end of file

diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor
index 8edd62260aa856ab460052e1ec029d230ec47c50..6884a10d039231cb822fd5471367ddb2bac929df 100644 (file)
--- a/core/source-files/source-files.factor
+++ b/core/source-files/source-files.factor
@@ -61,8 +61,7 @@ M: pathname where string>> 1 2array ;
     [
         source-file
         [ unxref-source ]
-        [ definitions>> [ keys forget-all ] each ]
-        bi
+        [ definitions>> [ keys forget-all ] each ] bi
     ]
     [ source-files get delete-at ]
     bi ;
@@ -82,7 +81,7 @@ SYMBOL: file
     \ source-file-error new
         f >>line#
         file get path>> >>file
-        swap >>error rethrow  ;
+        swap >>error rethrow ;
 
 : with-source-file ( name quot -- )
     #! Should be called from inside with-compilation-unit.