Add QUALIFIED-WITH: FROM: EXCLUDE: and RENAME: to the qualified vocab.

db4
Bruno Deferrari 2008-04-12 13:27:46 -03:00
parent 88bb122d1c
commit 9a467aa31a
3 changed files with 80 additions and 8 deletions

View File

@ -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" } } ;

View File

@ -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

View File

@ -1,13 +1,43 @@
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