vocabs.parser: The manifest is now a definition observer, and updates itself when compilation units complete. This helps keep listener's search path up to date if vocabularies and words are renamed, defined, and undefined

- This makes forget-vocab more reliable in the listener
- It also fixes the problem of listener sessions where QUALIFIED: was used referring to outdated words if the vocabulary in question was reloaded

basis/listener/listener.factor

@@ -193,13 +193,12 @@ SYMBOL: interactive-vocabs
 
 : with-interactive-vocabs ( quot -- )
     [
-        <manifest> manifest set
         "scratchpad" set-current-vocab
         interactive-vocabs get only-use-vocabs
         call
-    ] with-scope ; inline
+    ] with-manifest ; inline
 
 : listener ( -- )
-    [ [ { } (listener) ] with-interactive-vocabs ] with-return ;
+    [ [ { } (listener) ] with-return ] with-interactive-vocabs ;
 
 MAIN: listener

core/parser/parser.factor

@@ -111,11 +111,10 @@ SYMBOL: bootstrap-syntax
 
 : with-file-vocabs ( quot -- )
     [
-        <manifest> manifest set
         "syntax" use-vocab
         bootstrap-syntax get [ use-words ] when*
         call
-    ] with-scope ; inline
+    ] with-manifest ; inline
 
 SYMBOL: print-use-hook
 

core/vocabs/parser/parser-tests.factor

@@ -1,5 +1,6 @@
 IN: vocabs.parser.tests
-USING: vocabs.parser tools.test eval kernel accessors ;
+USING: vocabs.parser tools.test eval kernel accessors definitions
+compiler.units words vocabs ;
 
 [ "FROM: kernel => doesnotexist ;" eval( -- ) ]
 [ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ]
@@ -8,3 +9,43 @@ must-fail-with
 [ "RENAME: doesnotexist kernel => newname" eval( -- ) ]
 [ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ]
 must-fail-with
+
+: aaa ( -- ) ;
+
+[
+    [ ] [ "aaa" "vocabs.parser.tests" "uutt" add-renamed-word ] unit-test
+
+    [ ] [ "vocabs.parser.tests" dup add-qualified ] unit-test
+
+    [ aaa ] [ "uutt" search ] unit-test
+    [ aaa ] [ "vocabs.parser.tests:aaa" search ] unit-test
+
+    [ ] [ [ "bbb" "vocabs.parser.tests" create drop ] with-compilation-unit ] unit-test
+
+    [ "bbb" ] [ "vocabs.parser.tests:bbb" search name>> ] unit-test
+
+    [ ] [ [ \ aaa forget ] with-compilation-unit ] unit-test
+
+    [ ] [ [ "bbb" "vocabs.parser.tests" lookup forget ] with-compilation-unit ] unit-test
+
+    [ f ] [ "uutt" search ] unit-test
+
+    [ f ] [ "vocabs.parser.tests:aaa" search ] unit-test
+
+    [ ] [ "vocabs.parser.tests.foo" set-current-vocab ] unit-test
+
+    [ ] [ [ "bbb" current-vocab create drop ] with-compilation-unit ] unit-test
+    
+    [ t ] [ "bbb" search >boolean ] unit-test
+
+    [ ] [ [ "vocabs.parser.tests.foo" forget-vocab ] with-compilation-unit ] unit-test
+    
+    [ [ "bbb" current-vocab create drop ] with-compilation-unit ] [ error>> no-current-vocab? ] must-fail-with
+
+    [ begin-private ] [ error>> no-current-vocab? ] must-fail-with
+
+    [ end-private ] [ error>> no-current-vocab? ] must-fail-with
+
+    [ f ] [ "bbb" search >boolean ] unit-test
+    
+] with-manifest

core/vocabs/parser/parser.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2007, 2009 Daniel Ehrenberg, Bruno Deferrari,
+! Copyright (C) 2007, 2010 Daniel Ehrenberg, Bruno Deferrari,
 ! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs hashtables kernel namespaces sequences
 sets strings vocabs sorting accessors arrays compiler.units
-combinators vectors splitting continuations math
+combinators vectors splitting continuations math words
 parser.notes ;
 IN: vocabs.parser
 
@@ -26,7 +26,6 @@ current-vocab
 { search-vocab-names hashtable }
 { search-vocabs vector }
 { qualified-vocabs vector }
-{ extra-words vector }
 { auto-used vector } ;
 
 : <manifest> ( -- manifest )
@@ -34,7 +33,6 @@ current-vocab
         H{ } clone >>search-vocab-names
         V{ } clone >>search-vocabs
         V{ } clone >>qualified-vocabs
-        V{ } clone >>extra-words
         V{ } clone >>auto-used ;
 
 M: manifest clone
@@ -42,7 +40,6 @@ M: manifest clone
         [ clone ] change-search-vocab-names
         [ clone ] change-search-vocabs
         [ clone ] change-qualified-vocabs
-        [ clone ] change-extra-words
         [ clone ] change-auto-used ;
 
 TUPLE: extra-words words ;
@@ -69,10 +66,16 @@ ERROR: no-word-in-vocab word vocab ;
 : (from) ( vocab words -- vocab words words' vocab )
     2dup swap load-vocab ;
 
-: extract-words ( seq vocab -- assoc' )
+: extract-words ( seq vocab -- assoc )
     [ words>> extract-keys dup ] [ name>> ] bi
     [ swap [ 2drop ] [ no-word-in-vocab ] if ] curry assoc-each ;
 
+: excluding-words ( seq vocab -- assoc )
+    [ nip words>> ] [ extract-words ] 2bi assoc-diff ;
+
+: qualified-words ( prefix vocab -- assoc )
+    words>> swap [ swap [ swap ":" glue ] dip ] curry assoc-map ;
+
 : (lookup) ( name assoc -- word/f )
     at dup forward-reference? [ drop f ] when ;
 
@@ -102,11 +105,11 @@ TUPLE: no-current-vocab ;
     manifest get current-vocab>> [ no-current-vocab ] unless* ;
 
 : begin-private ( -- )
-    manifest get current-vocab>> vocab-name ".private" ?tail
+    current-vocab name>> ".private" ?tail
     [ drop ] [ ".private" append set-current-vocab ] if ;
 
 : end-private ( -- )
-    manifest get current-vocab>> vocab-name ".private" ?tail
+    current-vocab name>> ".private" ?tail
     [ set-current-vocab ] [ drop ] if ;
 
 : using-vocab? ( vocab -- ? )
@@ -137,10 +140,7 @@ TUPLE: no-current-vocab ;
 TUPLE: qualified vocab prefix words ;
 
 : <qualified> ( vocab prefix -- qualified )
-    2dup
+    (from) qualified-words qualified boa ;
-    [ load-vocab words>> ] [ CHAR: : suffix ] bi*
-    [ swap [ prepend ] dip ] curry assoc-map
-    qualified boa ;
 
 : add-qualified ( vocab prefix -- )
     <qualified> (add-qualified) ;
@@ -156,7 +156,7 @@ TUPLE: from vocab names words ;
 TUPLE: exclude vocab names words ;
 
 : <exclude> ( vocab words -- from )
-    (from) [ nip words>> ] [ extract-words ] 2bi assoc-diff exclude boa ;
+    (from) excluding-words exclude boa ;
 
 : add-words-excluding ( vocab words -- )
     <exclude> (add-qualified) ;
@@ -207,3 +207,43 @@ PRIVATE>
 
 : search ( name -- word/f )
     manifest get search-manifest ;
+
+<PRIVATE
+
+GENERIC: update ( search-path-elt -- valid? )
+
+: trim-forgotten ( qualified-vocab -- valid? )
+    [ [ nip "forgotten" word-prop not ] assoc-filter ] change-words
+    words>> assoc-empty? not ;
+
+M: from update trim-forgotten ;
+M: rename update trim-forgotten ;
+M: extra-words update trim-forgotten ;
+M: exclude update trim-forgotten ;
+
+M: qualified update
+    dup vocab>> vocab [
+        dup [ prefix>> ] [ vocab>> load-vocab ] bi qualified-words
+        >>words
+    ] [ drop f ] if ;
+
+M: vocab update dup name>> vocab eq? ;
+
+: update-manifest ( manifest -- )
+    [ dup [ name>> vocab ] when ] change-current-vocab
+    [ [ drop vocab ] assoc-filter ] change-search-vocab-names
+    dup search-vocab-names>> keys [ vocab ] V{ } map-as >>search-vocabs
+    qualified-vocabs>> [ update ] filter! drop ;
+
+M: manifest definitions-changed ( assoc manifest -- )
+    nip update-manifest ;
+
+PRIVATE>
+
+: with-manifest ( quot -- )
+    <manifest> manifest [
+        [ manifest get add-definition-observer call ]
+        [ manifest get remove-definition-observer ]
+        [ ]
+        cleanup
+    ] with-variable ; inline

core/words/words.factor

@@ -155,7 +155,12 @@ ERROR: bad-create name vocab ;
 
 : create ( name vocab -- word )
     check-create 2dup lookup
-    dup [ 2nip ] [ drop vocab-name <word> dup reveal ] if ;
+    dup [ 2nip ] [
+        drop
+        vocab-name <word>
+        dup reveal
+        dup changed-definition
+    ] if ;
 
 : constructor-word ( name vocab -- word )
     [ "<" ">" surround ] dip create ;