Better error reporting in FROM: and RENAME: words

diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor
index 395d5c3cafda80e4607c852cd7d321d5066f8c92..87c59e18a083b976238ac7300775abc54be32abb 100644 (file)
--- a/basis/fry/fry.factor
+++ b/basis/fry/fry.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences combinators parser splitting math
-quotations arrays make qualified words ;
+quotations arrays make words ;
 IN: fry
 
 : _ ( -- * ) "Only valid inside a fry" throw ;

diff --git a/basis/qualified/qualified-docs.factor b/basis/qualified/qualified-docs.factor
index d62f696a7490c9bc5e0e443f48a264bf025cbaab..067d221d2fc571e5703d4d88549a3b639d286287 100644 (file)
--- a/basis/qualified/qualified-docs.factor
+++ b/basis/qualified/qualified-docs.factor
@@ -32,3 +32,14 @@ HELP: RENAME:
     "RENAME: + math => -"
     "2 3 - ! => 5" } } ;
 
+ARTICLE: "qualified" "Qualified word lookup"
+"The " { $vocab-link "qualified" } " vocabulary provides a handful of parsing words which give more control over word lookup than is offered by " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } "."
+$nl
+"These words are useful when there is no way to avoid using two vocabularies with identical word names in the same source file."
+{ $subsection POSTPONE: QUALIFIED: }
+{ $subsection POSTPONE: QUALIFIED-WITH: }
+{ $subsection POSTPONE: FROM: }
+{ $subsection POSTPONE: EXCLUDE: }
+{ $subsection POSTPONE: RENAME: } ;
+
+ABOUT: "qualified"

diff --git a/basis/qualified/qualified-tests.factor b/basis/qualified/qualified-tests.factor
index 8f67ddf7309dfa3d78fac6ca7f6d06223a1de5d5..78efec4861d4b891552214c0ad949e6a94d9895b 100644 (file)
--- a/basis/qualified/qualified-tests.factor
+++ b/basis/qualified/qualified-tests.factor
@@ -1,24 +1,33 @@
-USING: tools.test qualified ;
-IN: foo
+USING: tools.test qualified eval accessors parser ;
+IN: qualified.tests.foo
 : x 1 ;
-IN: bar
+: y 5 ;
+IN: qualified.tests.bar
 : x 2 ;
-IN: baz
+: y 4 ;
+IN: qualified.tests.baz
 : x 3 ;
 
-QUALIFIED: foo
-QUALIFIED: bar
-[ 1 2 3 ] [ foo:x bar:x x ] unit-test
+QUALIFIED: qualified.tests.foo
+QUALIFIED: qualified.tests.bar
+[ 1 2 3 ] [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test
 
-QUALIFIED-WITH: bar p
+QUALIFIED-WITH: qualified.tests.bar p
 [ 2 ] [ p:x ] unit-test
 
-RENAME: x baz => y
+RENAME: x qualified.tests.baz => y
 [ 3 ] [ y ] unit-test
 
-FROM: baz => x ;
+FROM: qualified.tests.baz => x ;
 [ 3 ] [ x ] unit-test
+[ 3 ] [ y ] unit-test
 
-EXCLUDE: bar => x ;
+EXCLUDE: qualified.tests.bar => x ;
 [ 3 ] [ x ] unit-test
+[ 4 ] [ y ] unit-test
+
+[ "USE: qualified IN: qualified.tests FROM: qualified.tests => doesnotexist ;" eval ]
+[ error>> no-word-error? ] must-fail-with
 
+[ "USE: qualified IN: qualified.tests RENAME: doesnotexist qualified.tests => blah" eval ]
+[ error>> no-word-error? ] must-fail-with

diff --git a/basis/qualified/qualified.factor b/basis/qualified/qualified.factor
index d636cc01526d8069e3a74936e3ac426458952b16..d387ef4b0ecf8b7eb01b215fb6700ea73a52feea 100644 (file)
--- a/basis/qualified/qualified.factor
+++ b/basis/qualified/qualified.factor
@@ -1,12 +1,12 @@
 ! Copyright (C) 2007, 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences assocs hashtables parser lexer
-vocabs words namespaces vocabs.loader debugger sets ;
+vocabs words namespaces vocabs.loader debugger sets fry ;
 IN: qualified
 
 : define-qualified ( vocab-name prefix-name -- )
     [ load-vocab vocab-words ] [ CHAR: : suffix ] bi*
-    [ -rot >r append r> ] curry assoc-map
+    '[ [ [ _ ] dip append ] dip ] assoc-map
     use get push ;
 
 : QUALIFIED:
@@ -19,27 +19,27 @@ IN: qualified
 
 : expect=> ( -- ) scan "=>" assert= ;
 
-: partial-vocab ( words name -- assoc )
-    dupd [
-        lookup [ "No such word: " swap append throw ] unless*
-    ] curry map zip ;
+: partial-vocab ( words vocab -- assoc )
+    '[ dup _ lookup [ no-word-error ] unless* ]
+    { } map>assoc ;
 
-: partial-vocab-ignoring ( words name -- assoc )
+: FROM:
+    #! Syntax: FROM: vocab => words... ;
+    scan dup load-vocab drop expect=>
+    ";" parse-tokens swap partial-vocab use get push ; parsing
+
+: partial-vocab-excluding ( words vocab -- assoc )
     [ load-vocab vocab-words keys swap diff ] keep partial-vocab ;
 
 : EXCLUDE:
     #! Syntax: EXCLUDE: vocab => words ... ;
     scan expect=>
-    ";" parse-tokens swap partial-vocab-ignoring use get push ; parsing
-
-: FROM:
-    #! Syntax: FROM: vocab => words... ;
-    scan dup load-vocab drop expect=>
-    ";" parse-tokens swap partial-vocab use get push ; parsing
+    ";" parse-tokens swap partial-vocab-excluding use get push ; parsing
 
 : RENAME:
     #! Syntax: RENAME: word vocab => newname
-    scan scan dup load-vocab drop lookup [ "No such word" throw ] unless*
+    scan scan dup load-vocab drop
+    dupd lookup [ ] [ no-word-error ] ?if
     expect=>
     scan associate use get push ; parsing
 

diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor
index 1d8d1f0714a4f0a0098e1fd437ff707c478ebbf3..d33f5cd6d93d5424fa5b9a9745b64e8c54fafe40 100644 (file)
--- a/core/parser/parser-docs.factor
+++ b/core/parser/parser-docs.factor
@@ -69,7 +69,7 @@ $nl
 { $subsection POSTPONE: PRIVATE> }
 { $subsection "vocabulary-search-errors" }
 { $subsection "vocabulary-search-shadow" }
-{ $see-also "words" } ;
+{ $see-also "words" "qualified" } ;
 
 ARTICLE: "reading-ahead" "Reading ahead"
 "Parsing words can consume input:"

diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index a86715b0732a81e265aaaf97f632d3460d7a35a2..ed8fc4510b5d2897ad9bb85da0197ca25d707bbc 100644 (file)
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -71,10 +71,10 @@ ERROR: no-current-vocab ;
         ] keep
     ] { } map>assoc ;
 
-TUPLE: no-word-error name ;
+ERROR: no-word-error name ;
 
 : no-word ( name -- newword )
-    dup no-word-error boa
+    dup \ no-word-error boa
     swap words-named [ forward-reference? not ] filter
     word-restarts throw-restarts
     dup vocabulary>> (use+) ;