Remove interned predicate class
parent
38b4f67b70
commit
d9338b1cd2
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 } "." }
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue