From: Slava Pestov Date: Wed, 27 Jan 2010 07:26:40 +0000 (+1300) Subject: vocabs.parser: The manifest is now a definition observer, and updates itself when... X-Git-Tag: 0.97~5004^2~3 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=3237e48b2d446338e98cfe191095adf168ff25aa 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 --- diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor index a42eada563..d4da837fe1 100644 --- a/basis/listener/listener.factor +++ b/basis/listener/listener.factor @@ -193,13 +193,12 @@ SYMBOL: interactive-vocabs : with-interactive-vocabs ( quot -- ) [ - 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 diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 1433289f0a..e23673a479 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -111,11 +111,10 @@ SYMBOL: bootstrap-syntax : with-file-vocabs ( quot -- ) [ - manifest set "syntax" use-vocab bootstrap-syntax get [ use-words ] when* call - ] with-scope ; inline + ] with-manifest ; inline SYMBOL: print-use-hook diff --git a/core/vocabs/parser/parser-tests.factor b/core/vocabs/parser/parser-tests.factor index b9a3245b34..21a5066c1d 100644 --- a/core/vocabs/parser/parser-tests.factor +++ b/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" } } = ] @@ -7,4 +8,44 @@ must-fail-with [ "RENAME: doesnotexist kernel => newname" eval( -- ) ] [ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ] -must-fail-with \ No newline at end of file +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 \ No newline at end of file diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 7ca2027ec2..0bdec5f11c 100644 --- a/core/vocabs/parser/parser.factor +++ b/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 ) @@ -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 ; : ( vocab prefix -- qualified ) - 2dup - [ load-vocab words>> ] [ CHAR: : suffix ] bi* - [ swap [ prepend ] dip ] curry assoc-map - qualified boa ; + (from) qualified-words qualified boa ; : add-qualified ( vocab prefix -- ) (add-qualified) ; @@ -156,7 +156,7 @@ TUPLE: from vocab names words ; TUPLE: exclude vocab names words ; : ( vocab words -- from ) - (from) [ nip words>> ] [ extract-words ] 2bi assoc-diff exclude boa ; + (from) excluding-words exclude boa ; : add-words-excluding ( vocab words -- ) (add-qualified) ; @@ -207,3 +207,43 @@ PRIVATE> : search ( name -- word/f ) manifest get search-manifest ; + +> 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 get add-definition-observer call ] + [ manifest get remove-definition-observer ] + [ ] + cleanup + ] with-variable ; inline diff --git a/core/words/words.factor b/core/words/words.factor index 271dd558fc..7c0273389e 100644 --- a/core/words/words.factor +++ b/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 dup reveal ] if ; + dup [ 2nip ] [ + drop + vocab-name + dup reveal + dup changed-definition + ] if ; : constructor-word ( name vocab -- word ) [ "<" ">" surround ] dip create ;