Implement stricter vocab search path semantics, with a new API for vocabs.parser...

diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor
index 31af0291b46561f884984714f15dfa7ca9ba1e87..fc9e594be57824f4cb3dbda092498b2f58ca7634 100644 (file)
--- a/basis/alien/complex/functor/functor.factor
+++ b/basis/alien/complex/functor/functor.factor
@@ -23,7 +23,7 @@ WHERE
 : *T ( alien -- z )
     [ T-real ] [ T-imaginary ] bi rect> ; inline
 
-T in get
+T current-vocab
 { { N "real" } { N "imaginary" } }
 define-struct
 

diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor
index 0cc6d51446bdb82b4abff11912ecd56acc1b1c7a..d479e6d498e5a37b46ab5326f07300c1b3d22223 100644 (file)
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@@ -22,7 +22,7 @@ SYNTAX: TYPEDEF:
     scan scan typedef ;
 
 SYNTAX: C-STRUCT:
-    scan in get parse-definition define-struct ;
+    scan current-vocab parse-definition define-struct ;
 
 SYNTAX: C-UNION:
     scan parse-definition define-union ;

diff --git a/basis/command-line/command-line.factor b/basis/command-line/command-line.factor
index f2da4ebdf53ff90b91d2be8f7affdcd35a138b8d..19421359a395f96168981a6bcb37073c34a20561 100644 (file)
--- a/basis/command-line/command-line.factor
+++ b/basis/command-line/command-line.factor
@@ -69,6 +69,4 @@ SYMBOL: main-vocab-hook
 : ignore-cli-args? ( -- ? )
     os macosx? "run" get "ui" = and ;
 
-: script-mode ( -- ) ;
-
 [ default-cli-args ] "command-line" add-init-hook

diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index edd4932c66a05a7451168d24a79fea2614044dee..e5eb50e82f1e83b03ba34fc034b75b026e118955 100644 (file)
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -146,10 +146,10 @@ DEFER: ;FUNCTOR delimiter
     } ;
 
 : push-functor-words ( -- )
-    functor-words use get push ;
+    functor-words use-words ;
 
 : pop-functor-words ( -- )
-    functor-words use get delq ;
+    functor-words unuse-words ;
 
 : parse-functor-body ( -- form )
     push-functor-words

diff --git a/basis/help/syntax/syntax.factor b/basis/help/syntax/syntax.factor
index 1844d18d944c9ba56dc24e9aa61431e1a88590a9..af4b9e5e1222f74f3410cca7f3f14c35d8537301 100644 (file)
--- a/basis/help/syntax/syntax.factor
+++ b/basis/help/syntax/syntax.factor
@@ -16,4 +16,4 @@ SYNTAX: ARTICLE:
     ] dip remember-definition ;
 
 SYNTAX: ABOUT:
-    in get vocab scan-object >>help changed-definition ;
+    current-vocab scan-object >>help changed-definition ;

diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
index d6a8d1b54e60471d58a4a878652b9b15666cba6a..98b9a2ce237decfce4cf4f7fa54a882defe1fd79 100644 (file)
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -11,7 +11,7 @@ IN: io.sockets
 << {
     { [ os windows? ] [ "windows.winsock" ] }
     { [ os unix? ] [ "unix" ] }
-} cond add-ambiguous-use >>
+} cond use-vocab >>
 
 ! Addressing
 GENERIC: protocol-family ( addrspec -- af )

diff --git a/basis/listener/listener-tests.factor b/basis/listener/listener-tests.factor
index 9ae5250416b7788e2b5ed3bfec5bc02dcb4d3158..ccdd0be8c86d443d2035d7adfdf0cd51fe986af7 100644 (file)
--- a/basis/listener/listener-tests.factor
+++ b/basis/listener/listener-tests.factor
@@ -15,7 +15,7 @@ SYNTAX: hello "Hi" print ;
 ] with-file-vocabs
 
 [
-    "debugger" add-use
+    "debugger" add-ambiguous-use
 
     [ [ \ + 1 2 3 4 ] ]
     [

diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index 68777f2f73043fb34005f226d42a6e1a0979a2b1..4563f61ab79a146f08bf20a6d5a5dd6bcf0af38e 100644 (file)
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -10,7 +10,7 @@ IN: listener
 GENERIC: stream-read-quot ( stream -- quot/f )
 
 : parse-lines-interactive ( lines -- quot/f )
-    [ parse-lines in get ] with-compilation-unit in set ;
+    [ parse-lines ] with-compilation-unit ;
 
 : read-quot-step ( lines -- quot/f )
     [ parse-lines-interactive ] [
@@ -98,7 +98,7 @@ t error-summary? set-global
     ] [ drop ] if ;
 
 : prompt. ( -- )
-    in get auto-use? get [ " - auto" append ] when "( " " )" surround
+    current-vocab name>> auto-use? get [ " - auto" append ] when "( " " )" surround
     H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
 
 :: (listener) ( datastack -- )

diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor
index 5e9bdfbed6620286d98de669903471bc4d5d2b99..8cfe45d1ba7e53e1265b693c2168342e5da4b5ee 100644 (file)
--- a/basis/locals/parser/parser.factor
+++ b/basis/locals/parser/parser.factor
@@ -25,12 +25,6 @@ SYMBOL: in-lambda?
     [ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
     "local-word-def" set-word-prop ;
 
-: push-locals ( assoc -- )
-    use get push ;
-
-: pop-locals ( assoc -- )
-    use get delq ;
-
 SINGLETON: lambda-parser
 
 SYMBOL: locals
@@ -39,7 +33,9 @@ SYMBOL: locals
     '[
         in-lambda? on
         lambda-parser quotation-parser set
-        [ locals set ] [ push-locals @ ] [ pop-locals ] tri
+        [ locals set ]
+        [ use-words @ ]
+        [ unuse-words ] tri
     ] with-scope ; inline
     
 : (parse-lambda) ( assoc -- quot )
@@ -81,9 +77,9 @@ M: lambda-parser parse-quotation ( -- quotation )
 
 : parse-bindings* ( end -- words assoc )
     [
-        namespace push-locals
+        namespace use-words
         (parse-bindings)
-        namespace pop-locals
+        namespace unuse-words
     ] with-bindings ;
 
 : parse-let* ( -- form )

diff --git a/basis/opengl/gl/extensions/extensions.factor b/basis/opengl/gl/extensions/extensions.factor
index 8878e1904a9062cea1588105a2120ecbabc7f480..9aa4ee429d869ab3882277ad943e3fb819e082fe 100644 (file)
--- a/basis/opengl/gl/extensions/extensions.factor
+++ b/basis/opengl/gl/extensions/extensions.factor
@@ -9,7 +9,7 @@ ERROR: unknown-gl-platform ;
     { [ os macosx? ]  [ "opengl.gl.macosx" ] }
     { [ os unix? ] [ "opengl.gl.unix" ] }
     [ unknown-gl-platform ]
-} cond add-use >>
+} cond use-vocab >>
 
 SYMBOL: +gl-function-number-counter+
 SYMBOL: +gl-function-pointers+

diff --git a/basis/ui/pixel-formats/pixel-formats-docs.factor b/basis/ui/pixel-formats/pixel-formats-docs.factor
index 53e44ec18ee2c670da153d744f5755b2d1afce9e..b1ab1bc398dc5a28ab2421978be4b2c90d0b1ab7 100644 (file)
--- a/basis/ui/pixel-formats/pixel-formats-docs.factor
+++ b/basis/ui/pixel-formats/pixel-formats-docs.factor
@@ -1,12 +1,12 @@
 USING: destructors help.markup help.syntax kernel math multiline sequences
-vocabs vocabs.parser words ;
+vocabs vocabs.parser words namespaces ;
 IN: ui.pixel-formats
 
 ! break circular dependency
 <<
     "ui.gadgets.worlds" create-vocab drop
     "world" "ui.gadgets.worlds" create drop
-    "ui.gadgets.worlds" (add-use)
+    "ui.gadgets.worlds" vocab-words use-words
 >>
 
 ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes"

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 6ed3577a064dcce326cbdb91ae49df753868a549..19328b0b31c5d0a8b8ec6487135cdffa037fa85f 100644 (file)
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -38,13 +38,12 @@ output history flag mailbox thread waiting token-model word-model popup ;
         [ thread>> dup [ thread-registered? ] when ]
     } 1&& not ;
 
-SLOT: vocabs
+SLOT: manifest
 
-M: interactor vocabs>>
+M: interactor manifest>>
     dup interactor-busy? [ drop f ] [
-        use swap
         interactor-continuation name>>
-        assoc-stack
+        manifest swap assoc-stack
     ] if ;
 
 : vocab-exists? ( name -- ? )
@@ -56,7 +55,7 @@ M: vocab-completion (word-at-caret)
     drop dup vocab-exists? [ >vocab-link ] [ drop f ] if ;
 
 M: word-completion (word-at-caret)
-    vocabs>> assoc-stack ;
+    manifest>> search-manifest ;
 
 M: char-completion (word-at-caret)
     2drop f ;
@@ -300,15 +299,15 @@ M: listener-operation invoke-command ( target command -- )
 : clear-stack ( listener -- )
     [ [ clear ] \ clear ] dip (call-listener) ;
 
-: use-if-necessary ( word seq -- )
+: use-if-necessary ( word manifest -- )
     2dup [ vocabulary>> ] dip and [
-        2dup [ assoc-stack ] keep = [ 2drop ] [
-            [ vocabulary>> vocab-words ] dip push
-        ] if
+        manifest [
+            vocabulary>> use-vocab
+        ] with-variable
     ] [ 2drop ] if ;
 
 M: word accept-completion-hook
-    interactor>> vocabs>> use-if-necessary ;
+    interactor>> manifest>> use-if-necessary ;
 
 M: object accept-completion-hook 2drop ;
 

diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor
index 49bb74d18c9e3c92e255fbb3e9733bb1cf2d3fdf..4944cba1d637c7183f461e60f8fc744c9761632d 100644 (file)
--- a/basis/ui/tools/operations/operations.factor
+++ b/basis/ui/tools/operations/operations.factor
@@ -131,13 +131,13 @@ M: quotation com-stack-effect infer. ;
 
 M: word com-stack-effect 1quotation com-stack-effect ;
 
-: com-enter-in ( vocab -- ) vocab-name set-in ;
+: com-enter-in ( vocab -- ) vocab-name set-current-vocab ;
 
 [ vocab? ] \ com-enter-in H{
     { +listener+ t }
 } define-operation
 
-: com-use-vocab ( vocab -- ) vocab-name add-use ;
+: com-use-vocab ( vocab -- ) vocab-name use-vocab ;
 
 [ vocab-spec? ] \ com-use-vocab H{
     { +secondary+ t }

diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor
index 1da2dfee59c36bd363479685456c124c0f40a35e..088a8a632019ce8c9e545600a297ca753fe1940a 100644 (file)
--- a/core/bootstrap/stage1.factor
+++ b/core/bootstrap/stage1.factor
@@ -1,10 +1,10 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays debugger generic hashtables io assocs
-kernel.private kernel math memory namespaces make parser
-prettyprint sequences vectors words system splitting
-init io.files bootstrap.image bootstrap.image.private vocabs
-vocabs.loader system debugger continuations ;
+USING: arrays debugger generic hashtables io assocs kernel.private
+kernel math memory namespaces make parser prettyprint sequences
+vectors words system splitting init io.files vocabs vocabs.loader
+debugger continuations ;
+QUALIFIED: bootstrap.image.private
 IN: bootstrap.stage1
 
 "Bootstrap stage 1..." print flush
@@ -51,4 +51,4 @@ load-help? off
         ] if
     ] %
 ] [ ] make
-bootstrap-boot-quot set
+bootstrap.image.private:bootstrap-boot-quot set

diff --git a/core/classes/parser/parser.factor b/core/classes/parser/parser.factor
index 17a7b235528dfae9ef114791ac11f2cb39113eed..bd2e6ea4a07e3f28b3a3f85b95d3484c153c933f 100644 (file)
--- a/core/classes/parser/parser.factor
+++ b/core/classes/parser/parser.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: parser words kernel classes compiler.units lexer ;
+USING: parser vocabs.parser words kernel classes compiler.units lexer ;
 IN: classes.parser
 
 : save-class-location ( class -- )

diff --git a/core/init/init.factor b/core/init/init.factor
index 0140fcc0e8cd51fa7678e9bb10a5451e372ceb09..5d8e88b85f5b2ee4a78109e618f868d8773cf913 100644 (file)
--- a/core/init/init.factor
+++ b/core/init/init.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations continuations.private kernel
-kernel.private sequences assocs namespaces namespaces.private
-continuations continuations.private ;
+kernel.private sequences assocs namespaces namespaces.private ;
 IN: init
 
 SYMBOL: init-hooks

diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor
index ac3fbef8d06da264ab77d0613f82cd629c089347..84d1f52b9caec53491da3d2632c73371502ddb1a 100644 (file)
--- a/core/io/backend/backend.factor
+++ b/core/io/backend/backend.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: init kernel system namespaces io io.encodings
-io.encodings.utf8 init assocs splitting alien ;
+io.encodings.utf8 assocs splitting alien ;
 IN: io.backend
 
 SYMBOL: io-backend

diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index d802fd72fa5656e5e7ae14a29a98acb4d1be618d..31b5286c18b643d8d22ad26ace12272654bc2af0 100644 (file)
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -31,16 +31,6 @@ t parser-notes set-global
 
 M: parsing-word stack-effect drop (( parsed -- parsed )) ;
 
-TUPLE: no-current-vocab ;
-
-: no-current-vocab ( -- vocab )
-    \ no-current-vocab boa
-    { { "Define words in scratchpad vocabulary" "scratchpad" } }
-    throw-restarts dup set-in ;
-
-: current-vocab ( -- str )
-    in get [ no-current-vocab ] unless* ;
-
 : create-in ( str -- word )
     current-vocab create dup set-word dup save-location ;
 
@@ -55,7 +45,7 @@ SYMBOL: auto-use?
 : no-word-restarted ( restart-value -- word )
     dup word? [
         dup vocabulary>>
-        [ (add-use) ]
+        [ use-vocab ]
         [ amended-use get dup [ push ] [ 2drop ] if ]
         [ "Added \"" "\" vocabulary to search path" surround note. ]
         tri
@@ -134,8 +124,9 @@ SYMBOL: bootstrap-syntax
 
 : with-file-vocabs ( quot -- )
     [
-        f in set { "syntax" } set-use
-        bootstrap-syntax get [ use get push ] when*
+        <manifest> manifest set
+        "syntax" use-vocab
+        bootstrap-syntax get [ use-words ] when*
         call
     ] with-scope ; inline
 
@@ -195,8 +186,9 @@ SYMBOL: interactive-vocabs
 
 : with-interactive-vocabs ( quot -- )
     [
-        "scratchpad" in set
-        interactive-vocabs get set-use
+        <manifest> manifest set
+        "scratchpad" set-current-vocab
+        interactive-vocabs get only-use-vocabs
         call
     ] with-scope ; inline
 

diff --git a/core/sbufs/sbufs.factor b/core/sbufs/sbufs.factor
index 5590432ef4ca3908facee7aadd6fb31fcb704b26..0b2c170c1e6dacb46f29af1afae00b77256b4942 100644 (file)
--- a/core/sbufs/sbufs.factor
+++ b/core/sbufs/sbufs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math strings sequences.private sequences
+USING: accessors kernel math sequences.private sequences
 strings growable strings.private ;
 IN: sbufs
 

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index dd48501fa03ec6060c848dfe5ca6f35708768f62..99dddb8aedf744a9943b7c0af6ed5c6749236e5f 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -834,11 +834,20 @@ PRIVATE>
     [ [ 2unclip-slice ] dip [ call ] keep ] dip
     compose 2reduce ; inline
 
-: map-find ( seq quot -- result elt )
-    [ f ] 2dip
-    [ [ nip ] dip call dup ] curry find
+<PRIVATE
+
+: (map-find) ( seq quot find-quot -- result elt )
+    [ [ f ] 2dip [ [ nip ] dip call dup ] curry ] dip call
     [ [ drop f ] unless ] dip ; inline
 
+PRIVATE>
+
+: map-find ( seq quot -- result elt )
+    [ find ] (map-find) ; inline
+
+: map-find-last ( seq quot -- result elt )
+    [ find-last ] (map-find) ; inline
+
 : unclip-last-slice ( seq -- butlast-slice last )
     [ but-last-slice ] [ peek ] bi ; inline
 

diff --git a/core/slots/slots.factor b/core/slots/slots.factor
index 6bb854daf625d05d8598dc365f492d3f902723c8..304ded0adbb5e836fb05732c9d5f4a8290735604 100755 (executable)
--- a/core/slots/slots.factor
+++ b/core/slots/slots.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays byte-arrays kernel kernel.private math namespaces
-make sequences strings words effects generic generic.standard
+make sequences strings effects generic generic.standard
 classes classes.algebra slots.private combinators accessors
 words sequences.private assocs alien quotations hashtables ;
 IN: slots

diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index f2fa6b8771542826c235e8b37df3f99741fd3b97..0c0951bbceb5d150ccd64fde3bad33762e3ab62e 100644 (file)
--- a/core/sorting/sorting.factor
+++ b/core/sorting/sorting.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel math sequences vectors math.order
-sequences sequences.private math.order ;
+USING: accessors arrays kernel math vectors math.order
+sequences sequences.private ;
 IN: sorting
 
 ! Optimized merge-sort:

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index 8d52a2c786bd7967e43f2872d961ee819ecc0562..b29c20850bb183dcaf2776b33414cd10609c7c76 100644 (file)
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -41,28 +41,26 @@ IN: bootstrap.syntax
 
     "#!" [ POSTPONE: ! ] define-core-syntax
 
-    "IN:" [ scan set-in ] define-core-syntax
+    "IN:" [ scan set-current-vocab ] define-core-syntax
 
-    "PRIVATE>" [ in get ".private" ?tail drop set-in ] define-core-syntax
+    "<PRIVATE" [ begin-private ] define-core-syntax
 
-    "<PRIVATE" [
-        POSTPONE: PRIVATE> in get ".private" append set-in
-    ] define-core-syntax
+    "PRIVATE>" [ end-private ] define-core-syntax
 
-    "USE:" [ scan add-use ] define-core-syntax
+    "USE:" [ scan use-vocab ] define-core-syntax
 
-    "USING:" [ ";" parse-tokens [ add-use ] each ] define-core-syntax
+    "USING:" [ ";" parse-tokens [ use-vocab ] each ] define-core-syntax
 
     "QUALIFIED:" [ scan dup add-qualified ] define-core-syntax
 
     "QUALIFIED-WITH:" [ scan scan add-qualified ] define-core-syntax
 
     "FROM:" [
-        scan "=>" expect ";" parse-tokens swap add-words-from
+        scan "=>" expect ";" parse-tokens add-words-from
     ] define-core-syntax
 
     "EXCLUDE:" [
-        scan "=>" expect ";" parse-tokens swap add-words-excluding
+        scan "=>" expect ";" parse-tokens add-words-excluding
     ] define-core-syntax
 
     "RENAME:" [
@@ -227,7 +225,7 @@ IN: bootstrap.syntax
         "))" parse-effect parsed
     ] define-core-syntax
 
-    "MAIN:" [ scan-word in get vocab (>>main) ] define-core-syntax
+    "MAIN:" [ scan-word current-vocab (>>main) ] define-core-syntax
 
     "<<" [
         [

diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor
index d5978270dcd87db407f1f896a588ab3a55c1b4a4..426894794eff1badce95d92da6f72cc193b75ed4 100644 (file)
--- a/core/vocabs/parser/parser.factor
+++ b/core/vocabs/parser/parser.factor
@@ -2,71 +2,172 @@
 ! 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 ;
+sets strings vocabs sorting accessors arrays compiler.units
+combinators vectors splitting continuations ;
 IN: vocabs.parser
 
 ERROR: no-word-error name ;
 
-: word-restarts ( name possibilities -- restarts )
-    natural-sort
-    [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc
-    swap "Defer word in current vocabulary" swap 2array
-    suffix ;
+TUPLE: manifest
+current-vocab
+{ search-vocabs vector }
+{ qualified-vocabs vector }
+{ extra-words vector } ;
 
-: <no-word-error> ( name possibilities -- error restarts )
-    [ drop \ no-word-error boa ] [ word-restarts ] 2bi ;
+: <manifest> ( -- manifest )
+    manifest new
+        V{ } clone >>search-vocabs
+        V{ } clone >>qualified-vocabs
+        V{ } clone >>extra-words ;
 
-SYMBOL: use
-SYMBOL: in
+M: manifest clone
+    call-next-method
+        [ clone ] change-search-vocabs
+        [ clone ] change-qualified-vocabs
+        [ clone ] change-extra-words ;
 
-: (add-use) ( vocab -- )
-    vocab-words use get push ;
+<PRIVATE
 
-: add-use ( vocab -- )
-    load-vocab (add-use) ;
+: clear-manifest ( -- )
+    manifest get
+    [ search-vocabs>> delete-all ]
+    [ qualified-vocabs>> delete-all ]
+    [ extra-words>> delete-all ]
+    tri ;
 
-: set-use ( seq -- )
-    [ vocab-words ] V{ } map-as sift use set ;
+: (use-vocab) ( vocab -- vocab seq )
+    load-vocab manifest get search-vocabs>> ;
 
-: add-qualified ( vocab prefix -- )
-    [ load-vocab vocab-words ] [ CHAR: : suffix ] bi*
+: (add-qualified) ( qualified -- )
+    manifest get qualified-vocabs>> push ;
+
+: (from) ( vocab words -- vocab words words' assoc )
+    2dup swap load-vocab words>> ;
+
+: (use-words) ( assoc -- assoc seq )
+    manifest get extra-words>> ;
+
+: extract-words ( seq assoc -- assoc' )
+    extract-keys dup [ [ drop ] [ no-word-error ] if ] assoc-each ;
+
+: (lookup) ( name assoc -- word/f )
+    at dup forward-reference? [ drop f ] when ;
+
+PRIVATE>
+
+: set-current-vocab ( name -- )
+    create-vocab manifest get
+    [ (>>current-vocab) ]
+    [ [ words>> ] dip extra-words>> push ]
+    2bi ; 
+
+TUPLE: no-current-vocab ;
+
+: no-current-vocab ( -- vocab )
+    \ no-current-vocab boa
+    { { "Define words in scratchpad vocabulary" "scratchpad" } }
+    throw-restarts dup set-current-vocab ;
+
+: current-vocab ( -- vocab )
+    manifest get current-vocab>> [ no-current-vocab ] unless* ;
+
+: begin-private ( -- )
+    manifest get current-vocab>> vocab-name ".private" ?tail
+    [ drop ] [ ".private" append set-current-vocab ] if ;
+
+: end-private ( -- )
+    manifest get current-vocab>> vocab-name ".private" ?tail
+    [ set-current-vocab ] [ drop ] if ;
+
+: use-vocab ( vocab -- ) (use-vocab) push ;
+
+: unuse-vocab ( vocab -- ) (use-vocab) delq ;
+
+: only-use-vocabs ( vocabs -- )
+    clear-manifest
+    [ vocab ] V{ } map-as sift
+    manifest get search-vocabs>> push-all ;
+
+TUPLE: qualified vocab prefix words ;
+
+: <qualified> ( vocab prefix -- qualified )
+    2dup
+    [ load-vocab words>> ] [ CHAR: : suffix ] bi*
     [ swap [ prepend ] dip ] curry assoc-map
-    use get push ;
+    qualified boa ;
 
-: words-named-in ( words assoc -- assoc' )
-    [ dupd at [ no-word-error ] unless* ] curry { } map>assoc ;
+: add-qualified ( vocab prefix -- )
+    <qualified> (add-qualified) ;
+
+TUPLE: from vocab names words ;
+
+: <from> ( vocab words -- from )
+    (from) extract-words from boa ;
 
-: partial-vocab-including ( words vocab -- assoc )
-    load-vocab vocab-words words-named-in ;
+: add-words-from ( vocab words -- )
+    <from> (add-qualified) ;
 
-: add-words-from ( words vocab -- )
-    partial-vocab-including use get push ;
+TUPLE: exclude vocab names words ;
 
-: partial-vocab-excluding ( words vocab -- assoc )
-    load-vocab vocab-words [ nip ] [ words-named-in ] 2bi assoc-diff ;
+: <exclude> ( vocab words -- from )
+    (from) [ nip ] [ extract-words ] 2bi assoc-diff exclude boa ;
 
-: add-words-excluding ( words vocab -- )
-    partial-vocab-excluding use get push ;
+: add-words-excluding ( vocab words -- )
+    <exclude> (add-qualified) ;
+
+TUPLE: rename word vocab words ;
+
+: <rename> ( word vocab new-name -- rename )
+    [ 2dup load-vocab words>> dupd at [ ] [ no-word-error ] ?if ] dip
+    associate rename boa ;
 
 : add-renamed-word ( word vocab new-name -- )
-    [ load-vocab vocab-words dupd at [ ] [ no-word-error ] ?if ] dip
-    associate use get push ;
-
-: check-vocab-string ( name -- name )
-    dup string? [ "Vocabulary name must be a string" throw ] unless ;
-
-: set-in ( name -- )
-    check-vocab-string dup in set create-vocab (add-use) ;
-
-: check-forward ( str word -- word/f )
-    dup forward-reference? [
-        drop
-        use get
-        [ at ] with map sift
-        [ forward-reference? not ] find-last nip
-    ] [
-        nip
+    <rename> (add-qualified) ;
+
+: use-words ( words -- ) (use-words) push ;
+
+: unuse-words ( words -- ) (use-words) delq ;
+
+ERROR: ambiguous-use-error words ;
+
+<PRIVATE
+
+: (vocab-search) ( name assocs -- words n )
+    [ words>> (lookup) ] with map
+    sift dup length ;
+
+: vocab-search ( name manifest -- word/f )
+    search-vocabs>>
+    (vocab-search) {
+        { 0 [ drop f ] }
+        { 1 [ first ] }
+        [ drop ambiguous-use-error ]
+    } case ;
+
+: qualified-search ( name manifest -- word/f )
+    qualified-vocabs>>
+    (vocab-search) 0 = [ drop f ] [ peek ] if ;
+
+: word-search ( name manifest -- word/f )
+    extra-words>> [ (lookup) ] with map-find-last drop ;
+
+PRIVATE>
+
+: search-manifest ( name manifest -- word/f )
+    2dup word-search dup [ 2nip ] [
+        drop 2dup qualified-search dup [ 2nip ] [
+            drop vocab-search
+        ] if
     ] if ;
 
-: search ( str -- word/f )
-    dup use get assoc-stack check-forward ;
\ No newline at end of file
+: search ( name -- word/f )
+    manifest get search-manifest ;
+
+: word-restarts ( name possibilities -- restarts )
+    natural-sort
+    [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc
+    swap "Defer word in current vocabulary" swap 2array
+    suffix ;
+
+: <no-word-error> ( name possibilities -- error restarts )
+    [ drop \ no-word-error boa ] [ word-restarts ] 2bi ;

diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor
index 6c12b7b325b48a47586feb5e963b9c048dc1e2be..914f1cd601c4d9bf1dcf3bf5236d5228ed2d34ba 100644 (file)
--- a/core/vocabs/vocabs.factor
+++ b/core/vocabs/vocabs.factor
@@ -78,7 +78,13 @@ GENERIC: vocabs-changed ( obj -- )
 : notify-vocab-observers ( -- )
     vocab-observers get [ vocabs-changed ] each ;
 
+ERROR: bad-vocab-name name ;
+
+: check-vocab-name ( name -- name )
+    dup string? [ bad-vocab-name ] unless ;
+
 : create-vocab ( name -- vocab )
+    check-vocab-name
     dictionary get [ <vocab> ] cache
     notify-vocab-observers ;
 

diff --git a/core/words/words.factor b/core/words/words.factor
index c01cf13bcd1d270c978718b65029107fffe62f9b..2ebdb8b7a8ad0d9433be545d98c84ea3e1f26dd4 100755 (executable)
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays definitions graphs assocs kernel
-kernel.private kernel.private slots.private math namespaces sequences
+USING: accessors arrays definitions graphs kernel
+kernel.private slots.private math namespaces sequences
 strings vectors sbufs quotations assocs hashtables sorting vocabs
 math.order sets ;
 IN: words
@@ -180,12 +180,12 @@ M: word reset-word
 ERROR: bad-create name vocab ;
 
 : check-create ( name vocab -- name vocab )
-    2dup [ string? ] both?
+    2dup [ string? ] [ [ string? ] [ vocab? ] bi or ] bi* and
     [ bad-create ] unless ;
 
 : create ( name vocab -- word )
     check-create 2dup lookup
-    dup [ 2nip ] [ drop <word> dup reveal ] if ;
+    dup [ 2nip ] [ drop vocab-name <word> dup reveal ] if ;
 
 : constructor-word ( name vocab -- word )
     [ "<" ">" surround ] dip create ;

diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor
index 5597422898768672224e33f76c05fe8a97b87a0c..09f1b0e4b1a422049f7153c661d7a8080903c92d 100644 (file)
--- a/extra/infix/infix.factor
+++ b/extra/infix/infix.factor
@@ -85,12 +85,10 @@ SYNTAX: [infix
     "infix]" [infix-parse parsed \ call parsed ;
 
 <PRIVATE
+
 : parse-infix-locals ( assoc end -- quot )
-    [
-        in-lambda? on
-        [ dup [ locals set ] [ push-locals ] bi ] dip
-        [infix-parse prepare-operand swap pop-locals
-    ] with-scope ;
+    '[ _ [infix-parse prepare-operand ] ((parse-lambda)) ;
+
 PRIVATE>
 
 SYNTAX: [infix|