Remove interned predicate class

db4
Slava Pestov 2008-02-06 12:47:15 -06:00
parent 38b4f67b70
commit d9338b1cd2
8 changed files with 21 additions and 41 deletions

View File

@ -172,7 +172,9 @@ UNION: forget-class-bug-2 forget-class-bug-1 dll ;
FORGET: forget-class-bug-1
FORGET: forget-class-bug-2
[ t ] [ integer dll class-or interned? ] unit-test
[ f ] [ forget-class-bug-1 typemap get values [ memq? ] with contains? ] unit-test
[ f ] [ forget-class-bug-2 typemap get values [ memq? ] with contains? ] unit-test
DEFER: mixin-forget-test-g

View File

@ -92,8 +92,6 @@ DEFER: x-4
[ t ] [ \ x-3 "compiled-uses" word-prop >boolean ] unit-test
[ t ] [ \ x-3 "compiled-uses" word-prop [ drop interned? ] assoc-all? ] unit-test
DEFER: g-test-1
DEFER: g-test-3
@ -237,7 +235,7 @@ DEFER: flushable-test-2
: bx ax ;
[ \ bx forget ] with-compilation-unit
[ t ] [ \ ax compiled-usage [ drop interned? ] assoc-all? ] unit-test
[ f ] [ \ bx \ ax compiled-usage contains? ] unit-test
DEFER: defer-redefine-test-2

View File

@ -38,7 +38,7 @@ uses definitions ;
: (xref-source) ( source-file -- pathname uses )
dup source-file-path <pathname> swap source-file-uses
[ interned? ] subset ;
[ crossref? ] subset ;
: xref-source ( source-file -- )
(xref-source) crossref get add-vertex ;

View File

@ -123,7 +123,7 @@ TUPLE: yo-momma ;
[ ] [ \ yo-momma forget ] unit-test
[ f ] [ \ yo-momma typemap get values memq? ] unit-test
[ f ] [ \ yo-momma interned? ] unit-test
[ f ] [ \ yo-momma crossref ] unit-test
] with-compilation-unit
TUPLE: loc-recording ;

2
core/vocabs/vocabs-docs.factor Normal file → Executable file
View File

@ -76,7 +76,7 @@ HELP: all-words
HELP: forget-vocab
{ $values { "vocab" string } }
{ $description "Removes a vocabulary. All words in the vocabulary become uninterned." }
{ $description "Removes a vocabulary. All words in the vocabulary are forgotten." }
{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } ;
HELP: load-vocab-hook

View File

@ -14,9 +14,7 @@ $nl
{ $subsection lookup }
"Words can output their name and vocabulary:"
{ $subsection word-name }
{ $subsection word-vocabulary }
"Testing if a word object is part of a vocabulary:"
{ $subsection interned? } ;
{ $subsection word-vocabulary } ;
ARTICLE: "uninterned-words" "Uninterned words"
"A word that is not a member of any vocabulary is said to be " { $emphasis "uninterned" } "."
@ -369,18 +367,6 @@ HELP: delimiter?
{ $description "Tests if an object is a delimiter word declared by " { $link POSTPONE: delimiter } "." }
{ $notes "Outputs " { $link f } " if the object is not a word." } ;
HELP: interned
{ $class-description "The class of words defined in the " { $link dictionary } "." }
{ $examples
{ $example "\\ + interned? ." "t" }
{ $example "gensym interned? ." "f" }
} ;
HELP: rename-word
{ $values { "word" word } { "newname" string } { "newvocab" string } }
{ $description "Changes the name and vocabulary of a word, and adds it to its new vocabulary." }
{ $side-effects "word" } ;
HELP: make-flushable
{ $values { "word" word } }
{ $description "Declares a word as " { $link POSTPONE: flushable } "." }

View File

@ -54,22 +54,14 @@ GENERIC: testing
[ f ] [ \ testing generic? ] unit-test
[ f ] [ gensym interned? ] unit-test
: forgotten ;
: another-forgotten ;
[ f ] [ \ forgotten interned? ] unit-test
FORGET: forgotten
[ f ] [ \ another-forgotten interned? ] unit-test
FORGET: another-forgotten
: another-forgotten ;
[ t ] [ \ + interned? ] unit-test
! I forgot remove-crossref calls!
: fee ;
: foe fee ;
@ -87,8 +79,7 @@ FORGET: foe
] unit-test
[ t ] [
\ * usage [ word? ] subset
[ dup interned? swap method-body? or ] all?
\ * usage [ word? ] subset [ crossref? ] all?
] unit-test
DEFER: calls-a-gensym

View File

@ -1,10 +1,10 @@
! Copyright (C) 2004, 2007 Slava Pestov.
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: words
USING: arrays definitions graphs assocs kernel kernel.private
slots.private math namespaces sequences strings vectors sbufs
quotations assocs hashtables sorting math.parser words.private
vocabs ;
vocabs combinators ;
IN: words
: word ( -- word ) \ word get-global ;
@ -65,15 +65,20 @@ SYMBOL: bootstrapping?
: bootstrap-word ( word -- target )
[ target-word ] [ ] if-bootstrapping ;
PREDICATE: word interned dup target-word eq? ;
: crossref? ( word -- ? )
{
{ [ dup "forgotten" word-prop ] [ f ] }
{ [ dup "method" word-prop ] [ t ] }
{ [ dup word-vocabulary ] [ t ] }
{ [ t ] [ f ] }
} cond nip ;
GENERIC# (quot-uses) 1 ( obj assoc -- )
M: object (quot-uses) 2drop ;
M: word (quot-uses)
>r dup "forgotten" word-prop
[ r> 2drop ] [ dup r> set-at ] if ;
>r dup crossref? [ dup r> set-at ] [ r> 2drop ] if ;
: seq-uses ( seq assoc -- ) [ (quot-uses) ] curry each ;
@ -94,6 +99,7 @@ SYMBOL: compiled-crossref
compiled-crossref global [ H{ } assoc-like ] change-at
: compiled-xref ( word dependencies -- )
[ crossref? ] subset
2dup "compiled-uses" set-word-prop
compiled-crossref get add-vertex* ;
@ -118,9 +124,6 @@ SYMBOL: changed-words
[ no-compilation-unit ] unless*
set-at ;
: crossref? ( word -- ? )
dup word-vocabulary swap "method" word-prop or ;
: define ( word def -- )
[ ] like
over unxref