{ $description "Similar to " { $link POSTPONE: USE: } " but loads vocabulary with prefix." }
{ $examples { $code
"QUALIFIED: math\n1 2 math:+ ! ==> 3" } } ;
+
+HELP: QUALIFIED-WITH:
+{ $syntax "QUALIFIED-WITH: vocab prefix" }
+{ $description "Works like " { $link POSTPONE: QUALIFIED: } " but uses the specified prefix." }
+{ $examples { $code
+ "QUALIFIED-WITH: math m\n1 2 m:+ ! ==> 3" } } ;
+
+HELP: FROM:
+{ $syntax "FROM: vocab => words ... ;" }
+{ $description "Imports the specified words from vocab." }
+{ $examples { $code
+ "FROM: math.parser => bin> hex> ; ! imports only bin> and hex>" } } ;
+
+HELP: EXCLUDE:
+{ $syntax "EXCLUDE: vocab => words ... ;" }
+{ $description "Imports everything from vocab excluding the specified words" }
+{ $examples { $code
+ "EXCLUDE: math.parser => bin> hex> ; ! imports everythin but bin> and hex>" } } ;
+
+HELP: RENAME:
+{ $syntax "RENAME: word vocab => newname " }
+{ $description "Imports word from vocab, but renamed to newname." }
+{ $examples { $code
+ "RENAME: + math => -"
+ "2 3 - ! => 5" } } ;
+
-USING: kernel sequences assocs parser vocabs namespaces
-vocabs.loader ;
+USING: kernel sequences assocs hashtables parser vocabs words namespaces
+vocabs.loader debugger ;
IN: qualified
-: define-qualified ( vocab-name -- )
- dup require
- dup vocab-words swap CHAR: : suffix
+: define-qualified ( vocab-name prefix-name -- )
+ [ load-vocab vocab-words ] [ CHAR: : suffix ] bi*
[ -rot >r append r> ] curry assoc-map
use get push ;
-
: QUALIFIED:
- scan define-qualified ; parsing
+ #! Syntax: QUALIFIED: vocab
+ scan dup define-qualified ; parsing
+
+: QUALIFIED-WITH:
+ #! Syntax: QUALIFIED-WITH: vocab prefix
+ scan scan define-qualified ; parsing
+
+: expect=> scan "=>" assert= ;
+
+: partial-vocab ( words name -- assoc )
+ dupd [
+ lookup [ "No such word: " swap append throw ] unless*
+ ] curry map zip ;
+
+: partial-vocab-ignoring ( words name -- assoc )
+ [ vocab-words keys seq-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 expect=>
+ ";" parse-tokens swap partial-vocab use get push ; parsing
+
+: RENAME:
+ #! Syntax: RENAME: word vocab => newname
+ scan scan lookup [ "No such word" throw ] unless*
+ expect=>
+ scan associate use get push ; parsing
+