cleanups to vocabulary code

cvs
Slava Pestov 2005-07-23 05:03:46 +00:00
parent 74dc918e29
commit bd73c4eded
1 changed files with 8 additions and 19 deletions

View File

@ -5,8 +5,8 @@ USING: hashtables kernel lists namespaces strings sequences ;
SYMBOL: vocabularies
: word ( -- word ) global [ "last-word" get ] bind ;
: set-word ( word -- ) global [ "last-word" set ] bind ;
: word ( -- word ) "last-word" global hash ;
: set-word ( word -- ) "last-word" global set-hash ;
: vocabs ( -- list )
#! Push a list of vocabularies.
@ -22,7 +22,7 @@ SYMBOL: vocabularies
vocab dup [ hash-values [ ] subset word-sort ] when ;
: all-words ( -- list )
[ vocabs [ words % ] each ] make-list ;
vocabs [ words ] map concat ;
: each-word ( quot -- )
#! Apply a quotation to each word in the image.
@ -40,16 +40,11 @@ SYMBOL: vocabularies
global [ <namespace> crossref set ] bind
[ add-crossref ] each-word ;
: search ( name list -- word )
#! Search for a word in a list of vocabularies.
dup [
2dup car vocab ?hash [ nip ] [ cdr search ] ?ifte
] [
2drop f
] ifte ;
: search ( name vocabs -- word )
[ vocab ?hash ] map-with [ ] find nip ;
: <props> ( name vocab -- plist )
"vocabulary" swons swap "name" swons 2list alist>hash ;
<namespace> [ "vocabulary" set "name" set ] extend ;
: (create) ( name vocab -- word )
#! Create an undefined word without adding to a vocabulary.
@ -58,9 +53,7 @@ SYMBOL: vocabularies
: reveal ( word -- )
#! Add a new word to its vocabulary.
vocabularies get [
dup word-vocabulary nest [
dup word-name set
] bind
dup word-name over word-vocabulary nest set-hash
] bind ;
: create ( name vocab -- word )
@ -85,11 +78,7 @@ SYMBOL: vocabularies
: interned? ( word -- ? )
#! Test if the word is a member of its vocabulary.
dup dup word-name swap word-vocabulary dup [
vocab dup [ hash eq? ] [ 3drop f ] ifte
] [
3drop f
] ifte ;
dup word-name over word-vocabulary vocab ?hash eq? ;
: init-search-path ( -- )
! For files