Merge commit 'tizoc/master'

extra/qualified/qualified-docs.factor

@@ -6,3 +6,29 @@ HELP: QUALIFIED:
 { $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" } } ;
+

extra/qualified/qualified-tests.factor

@@ -3,6 +3,22 @@ IN: foo
 : x 1 ;
 IN: bar
 : x 2 ;
+IN: baz
+: x 3 ;
+
 QUALIFIED: foo
 QUALIFIED: bar
-[ 1 2 2 ] [ foo:x bar:x x ] unit-test
+[ 1 2 3 ] [ foo:x bar:x x ] unit-test
+
+QUALIFIED-WITH: bar p
+[ 2 ] [ p:x ] unit-test
+
+RENAME: x baz => y
+[ 3 ] [ y ] unit-test
+
+FROM: baz => x ;
+[ 3 ] [ x ] unit-test
+
+EXCLUDE: bar => x ;
+[ 3 ] [ x ] unit-test
+

extra/qualified/qualified.factor

@@ -1,13 +1,43 @@
-USING: kernel sequences assocs parser vocabs namespaces
+USING: kernel sequences assocs hashtables parser vocabs words namespaces
-vocabs.loader ;
+vocabs.loader debugger ;
 IN: qualified
 
-: define-qualified ( vocab-name -- )
+: define-qualified ( vocab-name prefix-name -- )
-    dup require
+    [ load-vocab vocab-words ] [ CHAR: : suffix ] bi*
-    dup vocab-words swap CHAR: : suffix
     [ -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
+