From a222fc6bd26af652484124004e08f0acaa054d4b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 18 Jul 2009 06:51:29 -0500
Subject: [PATCH] FROM: and RENAME: give a more meaningful error if the
 vocabulary does not exist

---
 basis/debugger/debugger.factor   |  6 ++++++
 core/vocabs/parser/parser.factor | 15 +++++++++------
 2 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index b10ca775f4..6c0985ce06 100644
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -258,6 +258,12 @@ M: no-word-error summary
 
 M: no-word-error error. summary print ;
 
+M: no-word-in-vocab summary
+    [ vocab>> ] [ word>> ] bi
+    [ "No word named ``" % % "'' found in ``" % % "'' vocabulary" % ] "" make ;
+
+M: no-word-in-vocab error. summary print ;
+
 M: ambiguous-use-error summary
     words>> first name>>
     "More than one vocabulary defines a word named ``" "''" surround ;
diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor
index 0bfb607a52..7ac0bd2e58 100644
--- a/core/vocabs/parser/parser.factor
+++ b/core/vocabs/parser/parser.factor
@@ -59,16 +59,19 @@ C: <extra-words> extra-words
     [ qualified-vocabs>> delete-all ]
     tri ;
 
+ERROR: no-word-in-vocab word vocab ;
+
 <PRIVATE
 
 : (add-qualified) ( qualified -- )
     manifest get qualified-vocabs>> push ;
 
-: (from) ( vocab words -- vocab words words' assoc )
-    2dup swap load-vocab words>> ;
+: (from) ( vocab words -- vocab words words' vocab )
+    2dup swap load-vocab ;
 
-: extract-words ( seq assoc -- assoc' )
-    extract-keys dup [ [ drop ] [ no-word-error ] if ] assoc-each ;
+: extract-words ( seq vocab -- assoc' )
+    [ words>> extract-keys dup ] [ name>> ] bi
+    [ swap [ 2drop ] [ no-word-in-vocab ] if ] curry assoc-each ;
 
 : (lookup) ( name assoc -- word/f )
     at dup forward-reference? [ drop f ] when ;
@@ -148,7 +151,7 @@ TUPLE: from vocab names words ;
 TUPLE: exclude vocab names words ;
 
 : <exclude> ( vocab words -- from )
-    (from) [ nip ] [ extract-words ] 2bi assoc-diff exclude boa ;
+    (from) [ nip words>> ] [ extract-words ] 2bi assoc-diff exclude boa ;
 
 : add-words-excluding ( vocab words -- )
     <exclude> (add-qualified) ;
@@ -156,7 +159,7 @@ TUPLE: exclude vocab names words ;
 TUPLE: rename word vocab words ;
 
 : <rename> ( word vocab new-name -- rename )
-    [ 2dup load-vocab words>> dupd at [ ] [ no-word-error ] ?if ] dip
+    [ 2dup load-vocab words>> dupd at [ ] [ swap no-word-in-vocab ] ?if ] dip
     associate rename boa ;
 
 : add-renamed-word ( word vocab new-name -- )