steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
library/vocabularies.factor
View File

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