Move cross-referencing stuff to tools.crossref since compiler doesn't depend on it anymore, and compute cross-referencing index as needed; reduces image size by ~4Mb

db4
Slava Pestov 2009-04-22 04:20:38 -05:00
parent dea3987ca5
commit 48e70b65fa
28 changed files with 219 additions and 381 deletions

View File

@ -16,13 +16,6 @@ SYMBOL: bootstrap-time
vm file-name os windows? [ "." split1-last drop ] when vm file-name os windows? [ "." split1-last drop ] when
".image" append resource-path ; ".image" append resource-path ;
: do-crossref ( -- )
"Cross-referencing..." print flush
H{ } clone crossref set-global
xref-words
xref-generics
xref-sources ;
: load-components ( -- ) : load-components ( -- )
"include" "exclude" "include" "exclude"
[ get-global " " split harvest ] bi@ [ get-global " " split harvest ] bi@
@ -68,8 +61,6 @@ SYMBOL: bootstrap-time
(command-line) parse-command-line (command-line) parse-command-line
do-crossref
! Set dll paths ! Set dll paths
os wince? [ "windows.ce" require ] when os wince? [ "windows.ce" require ] when
os winnt? [ "windows.nt" require ] when os winnt? [ "windows.nt" require ] when

View File

@ -17,8 +17,3 @@ HELP: xref-article
{ $values { "topic" "an article name or a word" } } { $values { "topic" "an article name or a word" } }
{ $description "Sets the " { $link article-parent } " of each child of this article." } { $description "Sets the " { $link article-parent } " of each child of this article." }
$low-level-note ; $low-level-note ;
HELP: unxref-article
{ $values { "topic" "an article name or a word" } }
{ $description "Clears the " { $link article-parent } " of each child of this article." }
$low-level-note ;

View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays definitions generic assocs math fry USING: arrays definitions generic assocs math fry
io kernel namespaces prettyprint prettyprint.sections io kernel namespaces prettyprint prettyprint.sections
@ -12,9 +12,6 @@ IN: help.crossref
: article-children ( topic -- seq ) : article-children ( topic -- seq )
{ $subsection } article-links ; { $subsection } article-links ;
M: link uses
{ $subsection $link $see-also } article-links ;
: help-path ( topic -- seq ) : help-path ( topic -- seq )
[ article-parent ] follow rest ; [ article-parent ] follow rest ;
@ -22,10 +19,7 @@ M: link uses
article-children [ set-article-parent ] with each ; article-children [ set-article-parent ] with each ;
: xref-article ( topic -- ) : xref-article ( topic -- )
dup >link xref dup set-article-parents ; dup set-article-parents ;
: unxref-article ( topic -- )
>link unxref ;
: prev/next ( obj seq n -- obj' ) : prev/next ( obj seq n -- obj' )
[ [ index dup ] keep ] dip swap [ [ index dup ] keep ] dip swap

View File

@ -156,10 +156,7 @@ help-hook [ [ print-topic ] ] initialize
error get (:help) ; error get (:help) ;
: remove-article ( name -- ) : remove-article ( name -- )
dup articles get key? [ articles get delete-at ;
dup unxref-article
dup articles get delete-at
] when drop ;
: add-article ( article name -- ) : add-article ( article name -- )
[ remove-article ] keep [ remove-article ] keep
@ -167,7 +164,6 @@ help-hook [ [ print-topic ] ] initialize
xref-article ; xref-article ;
: remove-word-help ( word -- ) : remove-word-help ( word -- )
dup word-help [ dup unxref-article ] when
f "help" set-word-prop ; f "help" set-word-prop ;
: set-word-help ( content word -- ) : set-word-help ( content word -- )

View File

@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators
sequences math namespaces.private continuations.private sequences math namespaces.private continuations.private
concurrency.messaging quotations kernel.private words concurrency.messaging quotations kernel.private words
sequences.private assocs models models.arrow arrays accessors sequences.private assocs models models.arrow arrays accessors
generic generic.standard definitions make sbufs ; generic generic.standard definitions make sbufs tools.crossref ;
IN: tools.continuations IN: tools.continuations
<PRIVATE <PRIVATE

View File

@ -1,15 +1,57 @@
USING: help.markup help.syntax words definitions prettyprint ; USING: help.markup help.syntax words definitions prettyprint
tools.crossref.private math quotations assocs ;
IN: tools.crossref IN: tools.crossref
ARTICLE: "tools.crossref" "Cross-referencing tools" ARTICLE: "tools.crossref" "Definition cross referencing"
"Definitions can answer a sequence of definitions they directly depend on:"
{ $subsection uses }
"An inverted index of the above:"
{ $subsection get-crossref }
"Words to access it:"
{ $subsection usage }
{ $subsection smart-usage }
"Tools for interactive use:"
{ $subsection usage. } { $subsection usage. }
{ $subsection vocab-uses. }
{ $subsection vocab-usage. }
{ $see-also "definitions" "words" "see" } ; { $see-also "definitions" "words" "see" } ;
ABOUT: "tools.crossref" ABOUT: "tools.crossref"
HELP: uses
{ $values { "defspec" "a definition specifier" } { "seq" "a sequence of definition specifiers" } }
{ $description "Outputs a sequence of definitions directory called by the given definition." }
{ $notes "The sequence might include the definition itself, if it is a recursive word." }
{ $examples
"We can ask the " { $link sq } " word to produce a list of words it calls:"
{ $unchecked-example "\ sq uses ." "{ dup * }" }
} ;
HELP: crossref
{ $var-description "A graph whose vertices are definition specifiers and edges are usages. See " { $link "graphs" } ". This variable is reset to " { $link f } " every time a definition is added or removed. Call " { $link get-crossref } " to lazily construct the graph instead of using this variable directly." } ;
HELP: get-crossref
{ $values { "crossref" assoc } }
{ $description "Outputs the cross-referencing index, mapping definitions to usages, building it first if necessary." }
{ $notes "This word is used to implement " { $link usage } " and " { $link usage. } "." } ;
HELP: crossref-def
{ $values { "defspec" "a definition specifier" } }
{ $description "Adds a vertex representing this definition, along with edges representing dependencies to the " { $link crossref } " graph." }
$low-level-note ;
HELP: usage
{ $values { "defspec" "a definition specifier" } { "seq" "a sequence of definition specifiers" } }
{ $description "Outputs a sequence of definitions that directly call the given definition." }
{ $notes "The sequence might include the definition itself, if it is a recursive word." } ;
HELP: usage. HELP: usage.
{ $values { "word" "a word" } } { $values { "word" "a word" } }
{ $description "Prints an list of all callers of a word. This may include the word itself, if it is recursive." } { $description "Prints an list of all callers of a word. This may include the word itself, if it is recursive." }
{ $examples { $code "\\ reverse usage." } } ; { $examples { $code "\\ reverse usage." } } ;
HELP: quot-uses
{ $values { "quot" quotation } { "assoc" "an assoc with words as keys" } }
{ $description "Outputs a set of words referenced by the quotation and any quotations it contains." } ;
{ usage usage. } related-words { usage usage. } related-words

View File

@ -11,3 +11,40 @@ M: integer foo + ;
[ t ] [ integer \ foo method \ + usage member? ] unit-test [ t ] [ integer \ foo method \ + usage member? ] unit-test
[ t ] [ \ foo usage [ pathname? ] any? ] unit-test [ t ] [ \ foo usage [ pathname? ] any? ] unit-test
! Issues with forget
GENERIC: generic-forget-test-1 ( a b -- c )
M: integer generic-forget-test-1 / ;
[ t ] [
\ / usage [ word? ] filter
[ name>> "integer=>generic-forget-test-1" = ] any?
] unit-test
[ ] [
[ \ generic-forget-test-1 forget ] with-compilation-unit
] unit-test
[ f ] [
\ / usage [ word? ] filter
[ name>> "integer=>generic-forget-test-1" = ] any?
] unit-test
GENERIC: generic-forget-test-2 ( a b -- c )
M: sequence generic-forget-test-2 = ;
[ t ] [
\ = usage [ word? ] filter
[ name>> "sequence=>generic-forget-test-2" = ] any?
] unit-test
[ ] [
[ M\ sequence generic-forget-test-2 forget ] with-compilation-unit
] unit-test
[ f ] [
\ = usage [ word? ] filter
[ name>> "sequence=>generic-forget-test-2" = ] any?
] unit-test

View File

@ -1,9 +1,84 @@
! Copyright (C) 2005, 2009 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs definitions io io.styles kernel prettyprint USING: words assocs definitions io io.pathnames io.styles kernel
sorting see ; prettyprint sorting see sets sequences arrays hashtables help.crossref
help.topics help.markup quotations accessors source-files namespaces
graphs vocabs generic generic.standard.engines.tuple threads
compiler.units init ;
IN: tools.crossref IN: tools.crossref
SYMBOL: crossref
GENERIC: uses ( defspec -- seq )
<PRIVATE
GENERIC# quot-uses 1 ( obj assoc -- )
M: object quot-uses 2drop ;
M: word quot-uses over crossref? [ conjoin ] [ 2drop ] if ;
: seq-uses ( seq assoc -- ) [ quot-uses ] curry each ;
M: array quot-uses seq-uses ;
M: hashtable quot-uses [ >alist ] dip seq-uses ;
M: callable quot-uses seq-uses ;
M: wrapper quot-uses [ wrapped>> ] dip quot-uses ;
M: callable uses ( quot -- assoc )
H{ } clone [ quot-uses ] keep keys ;
M: word uses def>> uses ;
M: link uses { $subsection $link $see-also } article-links ;
M: pathname uses string>> source-file top-level-form>> uses ;
GENERIC: crossref-def ( defspec -- )
M: object crossref-def
dup uses crossref get add-vertex ;
M: word crossref-def
[ call-next-method ] [ subwords [ crossref-def ] each ] bi ;
: build-crossref ( -- crossref )
"Computing usage index... " write flush yield
H{ } clone crossref [
all-words
source-files get keys [ <pathname> ] map
[ [ crossref-def ] each ] bi@
crossref get
] with-variable
"done" print flush ;
: get-crossref ( -- crossref )
crossref global [ drop build-crossref ] cache ;
GENERIC: irrelevant? ( defspec -- ? )
M: object irrelevant? drop f ;
M: default-method irrelevant? drop t ;
M: engine-word irrelevant? drop t ;
PRIVATE>
: usage ( defspec -- seq ) get-crossref at keys ;
GENERIC: smart-usage ( defspec -- seq )
M: object smart-usage usage [ irrelevant? not ] filter ;
M: method-body smart-usage "method-generic" word-prop smart-usage ;
M: f smart-usage drop \ f smart-usage ;
: synopsis-alist ( definitions -- alist ) : synopsis-alist ( definitions -- alist )
[ [ synopsis ] keep ] { } map>assoc ; [ [ synopsis ] keep ] { } map>assoc ;
@ -15,3 +90,34 @@ IN: tools.crossref
: usage. ( word -- ) : usage. ( word -- )
smart-usage sorted-definitions. ; smart-usage sorted-definitions. ;
: vocab-xref ( vocab quot -- vocabs )
[ [ vocab-name ] [ words [ generic? not ] filter ] bi ] dip map
[
[ [ word? ] [ generic? not ] bi and ] filter [
dup method-body?
[ "method-generic" word-prop ] when
vocabulary>>
] map
] gather natural-sort remove sift ; inline
: vocabs. ( seq -- )
[ dup >vocab-link write-object nl ] each ;
: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
: vocab-uses. ( vocab -- ) vocab-uses vocabs. ;
: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
: vocab-usage. ( vocab -- ) vocab-usage vocabs. ;
<PRIVATE
SINGLETON: invalidate-crossref
M: invalidate-crossref definitions-changed 2drop crossref global delete-at ;
[ invalidate-crossref add-definition-observer ] "tools.crossref" add-init-hook
PRIVATE>

View File

@ -1,5 +1,5 @@
USING: tools.profiler.private tools.time help.markup help.syntax USING: tools.profiler.private tools.time tools.crossref
quotations io strings words definitions ; help.markup help.syntax quotations io strings words definitions ;
IN: tools.profiler IN: tools.profiler
ARTICLE: "profiler-limitations" "Profiler limitations" ARTICLE: "profiler-limitations" "Profiler limitations"

View File

@ -3,7 +3,7 @@
USING: accessors words sequences math prettyprint kernel arrays io USING: accessors words sequences math prettyprint kernel arrays io
io.styles namespaces assocs kernel.private strings combinators io.styles namespaces assocs kernel.private strings combinators
sorting math.parser vocabs definitions tools.profiler.private sorting math.parser vocabs definitions tools.profiler.private
continuations generic compiler.units sets classes fry ; tools.crossref continuations generic compiler.units sets classes fry ;
IN: tools.profiler IN: tools.profiler
: profile ( quot -- ) : profile ( quot -- )

View File

@ -8,27 +8,6 @@ continuations compiler.errors init checksums checksums.crc32
sets accessors generic definitions words ; sets accessors generic definitions words ;
IN: tools.vocabs IN: tools.vocabs
: vocab-xref ( vocab quot -- vocabs )
[ [ vocab-name ] [ words [ generic? not ] filter ] bi ] dip map
[
[ [ word? ] [ generic? not ] bi and ] filter [
dup method-body?
[ "method-generic" word-prop ] when
vocabulary>>
] map
] gather natural-sort remove sift ; inline
: vocabs. ( seq -- )
[ dup >vocab-link write-object nl ] each ;
: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
: vocab-uses. ( vocab -- ) vocab-uses vocabs. ;
: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
: vocab-usage. ( vocab -- ) vocab-usage vocabs. ;
: vocab-tests-file ( vocab -- path ) : vocab-tests-file ( vocab -- path )
dup "-tests.factor" vocab-dir+ vocab-append-path dup dup "-tests.factor" vocab-dir+ vocab-append-path dup
[ dup exists? [ drop f ] unless ] [ drop f ] if ; [ dup exists? [ drop f ] unless ] [ drop f ] if ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs definitions fry help.topics kernel USING: accessors arrays assocs definitions fry help.topics kernel
colors.constants math.rectangles models.arrow namespaces sequences colors.constants math.rectangles models.arrow namespaces sequences
sorting definitions.icons ui.gadgets ui.gadgets.glass sorting definitions.icons tools.crossref ui.gadgets ui.gadgets.glass
ui.gadgets.labeled ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.labeled ui.gadgets.scrollers ui.gadgets.tables
ui.gadgets.search-tables ui.gadgets.wrappers ui.gestures ui.operations ui.gadgets.search-tables ui.gadgets.wrappers ui.gestures ui.operations
ui.pens.solid ui.images ; ui.pens.solid ui.images ;

View File

@ -12,8 +12,6 @@ IN: bootstrap.primitives
"Creating primitives and basic runtime structures..." print flush "Creating primitives and basic runtime structures..." print flush
crossref off
H{ } clone sub-primitives set H{ } clone sub-primitives set
"vocab:bootstrap/syntax.factor" parse-file "vocab:bootstrap/syntax.factor" parse-file

View File

@ -110,8 +110,6 @@ TUPLE: yo-momma ;
[ ] [ \ yo-momma forget ] unit-test [ ] [ \ yo-momma forget ] unit-test
[ ] [ \ <yo-momma> forget ] unit-test [ ] [ \ <yo-momma> forget ] unit-test
[ f ] [ \ yo-momma update-map get values memq? ] unit-test [ f ] [ \ yo-momma update-map get values memq? ] unit-test
[ f ] [ \ yo-momma crossref get at ] unit-test
] with-compilation-unit ] with-compilation-unit
TUPLE: loc-recording ; TUPLE: loc-recording ;

View File

@ -36,7 +36,7 @@ IN: compiler.units.tests
enable-compiler enable-compiler
] unit-test ] unit-test
! Notify observers even if compilation unit did nothing ! Check that we notify observers
SINGLETON: observer SINGLETON: observer
observer add-definition-observer observer add-definition-observer
@ -47,7 +47,7 @@ SYMBOL: counter
M: observer definitions-changed 2drop global [ counter inc ] bind ; M: observer definitions-changed 2drop global [ counter inc ] bind ;
[ ] with-compilation-unit [ gensym [ ] (( -- )) define-declared ] with-compilation-unit
[ 1 ] [ counter get-global ] unit-test [ 1 ] [ counter get-global ] unit-test

View File

@ -144,7 +144,7 @@ GENERIC: definitions-changed ( assoc obj -- )
update-tuples update-tuples
process-forgotten-definitions process-forgotten-definitions
modify-code-heap modify-code-heap
updated-definitions notify-definition-observers updated-definitions dup assoc-empty? [ drop ] [ notify-definition-observers ] if
notify-error-observers ; notify-error-observers ;
: with-nested-compilation-unit ( quot -- ) : with-nested-compilation-unit ( quot -- )

View File

@ -10,21 +10,11 @@ $nl
{ $subsection set-where } { $subsection set-where }
"Definitions can be removed:" "Definitions can be removed:"
{ $subsection forget } { $subsection forget }
"Definitions can answer a sequence of definitions they directly depend on:"
{ $subsection uses }
"Definitions must implement a few operations used for printing them in source form:" "Definitions must implement a few operations used for printing them in source form:"
{ $subsection definer } { $subsection definer }
{ $subsection definition } { $subsection definition }
{ $see-also "see" } ; { $see-also "see" } ;
ARTICLE: "definition-crossref" "Definition cross referencing"
"A common cross-referencing system is used to track definition usages:"
{ $subsection crossref }
{ $subsection xref }
{ $subsection unxref }
{ $subsection delete-xref }
{ $subsection usage } ;
ARTICLE: "definition-checking" "Definition sanity checking" ARTICLE: "definition-checking" "Definition sanity checking"
"When a source file is reloaded, the parser compares the previous list of definitions with the current list; any definitions which are no longer present in the file are removed by a call to " { $link forget } ". A warning message is printed if any other definitions still depend on the removed definitions." "When a source file is reloaded, the parser compares the previous list of definitions with the current list; any definitions which are no longer present in the file are removed by a call to " { $link forget } ". A warning message is printed if any other definitions still depend on the removed definitions."
$nl $nl
@ -69,7 +59,6 @@ $nl
} }
"For every source file loaded into the system, a list of definitions is maintained. Pathname objects implement the definition protocol, acting over the definitions their source files contain. See " { $link "source-files" } " for details." "For every source file loaded into the system, a list of definitions is maintained. Pathname objects implement the definition protocol, acting over the definitions their source files contain. See " { $link "source-files" } " for details."
{ $subsection "definition-protocol" } { $subsection "definition-protocol" }
{ $subsection "definition-crossref" }
{ $subsection "definition-checking" } { $subsection "definition-checking" }
{ $subsection "compilation-units" } { $subsection "compilation-units" }
"A parsing word to remove definitions:" "A parsing word to remove definitions:"
@ -96,36 +85,3 @@ HELP: forget-all
{ $values { "definitions" "a sequence of definition specifiers" } } { $values { "definitions" "a sequence of definition specifiers" } }
{ $description "Forgets every definition in a sequence." } { $description "Forgets every definition in a sequence." }
{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } ; { $notes "This word must be called from inside " { $link with-compilation-unit } "." } ;
HELP: uses
{ $values { "defspec" "a definition specifier" } { "seq" "a sequence of definition specifiers" } }
{ $description "Outputs a sequence of definitions directory called by the given definition." }
{ $notes "The sequence might include the definition itself, if it is a recursive word." }
{ $examples
"We can ask the " { $link sq } " word to produce a list of words it calls:"
{ $unchecked-example "\ sq uses ." "{ dup * }" }
} ;
HELP: crossref
{ $var-description "A graph whose vertices are definition specifiers and edges are usages. See " { $link "graphs" } "." } ;
HELP: xref
{ $values { "defspec" "a definition specifier" } }
{ $description "Adds a vertex representing this definition, along with edges representing dependencies to the " { $link crossref } " graph." }
$low-level-note ;
HELP: usage
{ $values { "defspec" "a definition specifier" } { "seq" "a sequence of definition specifiers" } }
{ $description "Outputs a sequence of definitions that directly call the given definition." }
{ $notes "The sequence might include the definition itself, if it is a recursive word." } ;
HELP: unxref
{ $values { "defspec" "a definition specifier" } }
{ $description "Remove edges leaving the vertex which represents the definition from the " { $link crossref } " graph." }
{ $notes "This word is called before a word is redefined." } ;
HELP: delete-xref
{ $values { "defspec" "a definition specifier" } }
{ $description "Remove the vertex which represents the definition from the " { $link crossref } " graph." }
{ $notes "This word is called before a word is forgotten." }
{ $see-also forget } ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2009 Slava Pestov. ! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences namespaces assocs graphs math math.order ; USING: kernel sequences namespaces assocs math ;
IN: definitions IN: definitions
MIXIN: definition MIXIN: definition
@ -53,29 +53,3 @@ SYMBOL: forgotten-definitions
GENERIC: definer ( defspec -- start end ) GENERIC: definer ( defspec -- start end )
GENERIC: definition ( defspec -- seq ) GENERIC: definition ( defspec -- seq )
SYMBOL: crossref
GENERIC: uses ( defspec -- seq )
M: object uses drop f ;
: xref ( defspec -- ) dup uses crossref get add-vertex ;
: usage ( defspec -- seq ) crossref get at keys ;
GENERIC: irrelevant? ( defspec -- ? )
M: object irrelevant? drop f ;
GENERIC: smart-usage ( defspec -- seq )
M: f smart-usage drop \ f smart-usage ;
M: object smart-usage usage [ irrelevant? not ] filter ;
: unxref ( defspec -- )
dup uses crossref get remove-vertex ;
: delete-xref ( defspec -- )
dup unxref crossref get delete-at ;

View File

@ -133,69 +133,19 @@ M: f tag-and-f 4 ;
[ 3.4 3 ] [ 3.4 tag-and-f ] unit-test [ 3.4 3 ] [ 3.4 tag-and-f ] unit-test
! Issues with forget ! Issues with forget
GENERIC: generic-forget-test-1 ( a b -- c ) GENERIC: generic-forget-test ( a -- b )
M: integer generic-forget-test-1 / ; M: f generic-forget-test ;
[ t ] [ [ ] [ \ f \ generic-forget-test method "m" set ] unit-test
\ / usage [ word? ] filter
[ name>> "integer=>generic-forget-test-1" = ] any?
] unit-test
[ ] [
[ \ generic-forget-test-1 forget ] with-compilation-unit
] unit-test
[ f ] [
\ / usage [ word? ] filter
[ name>> "integer=>generic-forget-test-1" = ] any?
] unit-test
GENERIC: generic-forget-test-2 ( a b -- c )
M: sequence generic-forget-test-2 = ;
[ t ] [
\ = usage [ word? ] filter
[ name>> "sequence=>generic-forget-test-2" = ] any?
] unit-test
[ ] [
[ M\ sequence generic-forget-test-2 forget ] with-compilation-unit
] unit-test
[ f ] [
\ = usage [ word? ] filter
[ name>> "sequence=>generic-forget-test-2" = ] any?
] unit-test
GENERIC: generic-forget-test-3 ( a -- b )
M: f generic-forget-test-3 ;
[ ] [ \ f \ generic-forget-test-3 method "m" set ] unit-test
[ ] [ [ "m" get forget ] with-compilation-unit ] unit-test [ ] [ [ "m" get forget ] with-compilation-unit ] unit-test
[ ] [ "IN: generic.tests M: f generic-forget-test-3 ;" eval( -- ) ] unit-test [ ] [ "IN: generic.tests M: f generic-forget-test ;" eval( -- ) ] unit-test
[ ] [ [ "m" get forget ] with-compilation-unit ] unit-test [ ] [ [ "m" get forget ] with-compilation-unit ] unit-test
[ f ] [ f generic-forget-test-3 ] unit-test [ f ] [ f generic-forget-test ] unit-test
: a-word ( -- ) ;
GENERIC: a-generic ( a -- b )
M: integer a-generic a-word ;
[ ] [ \ integer \ a-generic method "m" set ] unit-test
[ t ] [ "m" get \ a-word usage memq? ] unit-test
[ ] [ "IN: generic.tests : a-generic ( -- ) ;" eval( -- ) ] unit-test
[ f ] [ "m" get \ a-word usage memq? ] unit-test
! erg's regression ! erg's regression
[ ] [ [ ] [

View File

@ -123,8 +123,6 @@ M: method-body crossref?
PREDICATE: default-method < word "default" word-prop ; PREDICATE: default-method < word "default" word-prop ;
M: default-method irrelevant? drop t ;
: <default-method> ( generic combination -- method ) : <default-method> ( generic combination -- method )
[ drop object bootstrap-word swap <method> ] [ make-default-method ] 2bi [ drop object bootstrap-word swap <method> ] [ make-default-method ] 2bi
[ define ] [ drop t "default" set-word-prop ] [ drop ] 2tri ; [ define ] [ drop t "default" set-word-prop ] [ drop ] 2tri ;
@ -155,9 +153,6 @@ M: method-body forget*
[ call-next-method ] bi [ call-next-method ] bi
] if ; ] if ;
M: method-body smart-usage
"method-generic" word-prop smart-usage ;
M: sequence update-methods ( class seq -- ) M: sequence update-methods ( class seq -- )
implementors [ implementors [
[ changed-generic ] [ remake-generic drop ] 2bi [ changed-generic ] [ remake-generic drop ] 2bi
@ -192,6 +187,3 @@ M: generic forget*
M: class forget-methods M: class forget-methods
[ implementors ] [ [ swap method ] curry ] bi map forget-all ; [ implementors ] [ [ swap method ] curry ] bi map forget-all ;
: xref-generics ( -- )
all-words [ subwords [ xref ] each ] each ;

View File

@ -86,8 +86,6 @@ M: engine-word where "tuple-dispatch-generic" word-prop where ;
M: engine-word crossref? "forgotten" word-prop not ; M: engine-word crossref? "forgotten" word-prop not ;
M: engine-word irrelevant? drop t ;
: remember-engine ( word -- ) : remember-engine ( word -- )
generic get "engines" word-prop push ; generic get "engines" word-prop push ;

View File

@ -280,27 +280,6 @@ M: growable call-next-hooker call-next-method "growable " prepend ;
V{ } my-var [ call-next-hooker ] with-variable V{ } my-var [ call-next-hooker ] with-variable
] unit-test ] unit-test
! Cross-referencing with generic words
TUPLE: xref-tuple-1 ;
TUPLE: xref-tuple-2 < xref-tuple-1 ;
: (xref-test) ( obj -- ) drop ;
GENERIC: xref-test ( obj -- )
M: xref-tuple-1 xref-test (xref-test) ;
M: xref-tuple-2 xref-test (xref-test) ;
[ t ] [
\ xref-test
\ xref-tuple-1 \ xref-test method [ usage unique ] closure key?
] unit-test
[ t ] [
\ xref-test
\ xref-tuple-2 \ xref-test method [ usage unique ] closure key?
] unit-test
[ t ] [ [ t ] [
{ } \ nth effective-method nip \ sequence \ nth method eq? { } \ nth effective-method nip \ sequence \ nth method eq?
] unit-test ] unit-test

View File

@ -264,7 +264,7 @@ print-use-hook [ [ ] ] initialize
: finish-parsing ( lines quot -- ) : finish-parsing ( lines quot -- )
file get file get
[ record-form ] [ record-top-level-form ]
[ record-definitions ] [ record-definitions ]
[ record-checksum ] [ record-checksum ]
tri ; tri ;

View File

@ -11,9 +11,7 @@ $nl
{ $subsection source-file } { $subsection source-file }
"Words intended for the parser:" "Words intended for the parser:"
{ $subsection record-checksum } { $subsection record-checksum }
{ $subsection record-form } { $subsection record-definitions }
{ $subsection xref-source }
{ $subsection unxref-source }
"Removing a source file from the database:" "Removing a source file from the database:"
{ $subsection forget-source } { $subsection forget-source }
"Updating the database:" "Updating the database:"
@ -42,25 +40,6 @@ HELP: record-checksum
{ $description "Records the CRC32 checksm of the source file's contents." } { $description "Records the CRC32 checksm of the source file's contents." }
$low-level-note ; $low-level-note ;
HELP: xref-source
{ $values { "source-file" source-file } }
{ $description "Adds the source file to the " { $link crossref } " graph enabling words to find source files which reference them in their top level forms." }
$low-level-note ;
HELP: unxref-source
{ $values { "source-file" source-file } }
{ $description "Removes the source file from the " { $link crossref } " graph." }
$low-level-note ;
HELP: xref-sources
{ $description "Adds all loaded source files to the " { $link crossref } " graph. This is done during bootstrap." }
$low-level-note ;
HELP: record-form
{ $values { "quot" quotation } { "source-file" source-file } }
{ $description "Records usage information for a source file's top level form." }
$low-level-note ;
HELP: reset-checksums HELP: reset-checksums
{ $description "Resets recorded modification times and CRC32 checksums for all loaded source files, creating a checkpoint for " { $link "tools.vocabs" } "." } ; { $description "Resets recorded modification times and CRC32 checksums for all loaded source files, creating a checkpoint for " { $link "tools.vocabs" } "." } ;

View File

@ -1,4 +1,4 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays definitions generic assocs kernel math namespaces USING: arrays definitions generic assocs kernel math namespaces
sequences strings vectors words quotations io io.files sequences strings vectors words quotations io io.files
@ -11,29 +11,16 @@ SYMBOL: source-files
TUPLE: source-file TUPLE: source-file
path path
top-level-form
checksum checksum
uses definitions ; definitions ;
: record-top-level-form ( quot file -- )
(>>top-level-form) H{ } notify-definition-observers ;
: record-checksum ( lines source-file -- ) : record-checksum ( lines source-file -- )
[ crc32 checksum-lines ] dip (>>checksum) ; [ crc32 checksum-lines ] dip (>>checksum) ;
: (xref-source) ( source-file -- pathname uses )
[ path>> <pathname> ]
[ uses>> [ crossref? ] filter ] bi ;
: xref-source ( source-file -- )
(xref-source) crossref get add-vertex ;
: unxref-source ( source-file -- )
(xref-source) crossref get remove-vertex ;
: xref-sources ( -- )
source-files get [ nip xref-source ] assoc-each ;
: record-form ( quot source-file -- )
[ quot-uses keys ] dip
[ unxref-source ] [ (>>uses) ] [ xref-source ] tri ;
: record-definitions ( file -- ) : record-definitions ( file -- )
new-definitions get >>definitions drop ; new-definitions get >>definitions drop ;
@ -58,13 +45,8 @@ ERROR: invalid-source-file-path path ;
M: pathname where string>> 1 2array ; M: pathname where string>> 1 2array ;
: forget-source ( path -- ) : forget-source ( path -- )
[ source-files get delete-at*
source-file [ definitions>> [ keys forget-all ] each ] [ drop ] if ;
[ unxref-source ]
[ definitions>> [ keys forget-all ] each ] bi
]
[ source-files get delete-at ]
bi ;
M: pathname forget* M: pathname forget*
string>> forget-source ; string>> forget-source ;

View File

@ -290,10 +290,6 @@ HELP: define-temp
"This word must be called from inside " { $link with-compilation-unit } "." "This word must be called from inside " { $link with-compilation-unit } "."
} ; } ;
HELP: quot-uses
{ $values { "quot" quotation } { "assoc" "an assoc with words as keys" } }
{ $description "Outputs a set of words referenced by the quotation and any quotations it contains." } ;
HELP: delimiter? HELP: delimiter?
{ $values { "obj" object } { "?" "a boolean" } } { $values { "obj" object } { "?" "a boolean" } }
{ $description "Tests if an object is a delimiter word declared by " { $link POSTPONE: delimiter } "." } { $description "Tests if an object is a delimiter word declared by " { $link POSTPONE: delimiter } "." }

View File

@ -63,52 +63,6 @@ FORGET: forgotten
FORGET: another-forgotten FORGET: another-forgotten
: another-forgotten ( -- ) ; : another-forgotten ( -- ) ;
! I forgot remove-crossref calls!
: fee ( -- ) ;
: foe ( -- ) fee ;
: fie ( -- ) foe ;
[ t ] [ \ fee usage [ word? ] filter empty? ] unit-test
[ t ] [ \ foe usage empty? ] unit-test
[ f ] [ \ foe crossref get key? ] unit-test
FORGET: foe
! xref should not retain references to gensyms
[ ] [
[ gensym [ * ] define ] with-compilation-unit
] unit-test
[ t ] [
\ * usage [ word? ] filter [ crossref? ] all?
] unit-test
DEFER: calls-a-gensym
[ ] [
[
\ calls-a-gensym
gensym dup "x" set 1quotation
(( x -- x )) define-declared
] with-compilation-unit
] unit-test
[ f ] [ "x" get crossref get at ] unit-test
! more xref buggery
[ f ] [
GENERIC: xyzzle ( x -- x )
: a ( -- ) ; \ a
M: integer xyzzle a ;
FORGET: a
M: object xyzzle ;
crossref get at
] unit-test
! regression
GENERIC: freakish ( x -- y )
: bar ( x -- y ) freakish ;
M: array freakish ;
[ t ] [ \ bar \ freakish usage member? ] unit-test
DEFER: x DEFER: x
[ x ] [ undefined? ] must-fail-with [ x ] [ undefined? ] must-fail-with
@ -122,26 +76,6 @@ DEFER: x
[ ] [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test [ ] [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
[ "test-last" ] [ word name>> ] unit-test [ "test-last" ] [ word name>> ] unit-test
! regression
SYMBOL: quot-uses-a
SYMBOL: quot-uses-b
[ ] [
[
quot-uses-a [ 2 3 + ] define
] with-compilation-unit
] unit-test
[ { + } ] [ \ quot-uses-a uses ] unit-test
[ ] [
[
quot-uses-b 2 [ 3 + ] curry define
] with-compilation-unit
] unit-test
[ { + } ] [ \ quot-uses-b uses ] unit-test
"undef-test" "words.tests" lookup [ "undef-test" "words.tests" lookup [
[ forget ] with-compilation-unit [ forget ] with-compilation-unit
] when* ] when*
@ -191,8 +125,3 @@ SYMBOL: quot-uses-b
keys [ "forgotten" word-prop ] any? keys [ "forgotten" word-prop ] any?
] filter ] filter
] unit-test ] unit-test
[ { } ] [
crossref get keys
[ word? ] filter [ "forgotten" word-prop ] filter
] unit-test

View File

@ -62,33 +62,7 @@ SYMBOL: bootstrapping?
GENERIC: crossref? ( word -- ? ) GENERIC: crossref? ( word -- ? )
M: word crossref? M: word crossref?
dup "forgotten" word-prop [ dup "forgotten" word-prop [ drop f ] [ vocabulary>> >boolean ] if ;
drop f
] [
vocabulary>> >boolean
] if ;
GENERIC# (quot-uses) 1 ( obj assoc -- )
M: object (quot-uses) 2drop ;
M: word (quot-uses) over crossref? [ conjoin ] [ 2drop ] if ;
: seq-uses ( seq assoc -- ) [ (quot-uses) ] curry each ;
M: array (quot-uses) seq-uses ;
M: hashtable (quot-uses) [ >alist ] dip seq-uses ;
M: callable (quot-uses) seq-uses ;
M: wrapper (quot-uses) [ wrapped>> ] dip (quot-uses) ;
: quot-uses ( quot -- assoc )
global [ H{ } clone [ (quot-uses) ] keep ] bind ;
M: word uses ( word -- seq )
def>> quot-uses keys ;
SYMBOL: compiled-crossref SYMBOL: compiled-crossref
@ -132,11 +106,7 @@ GENERIC: subwords ( word -- seq )
M: word subwords drop f ; M: word subwords drop f ;
: define ( word def -- ) : define ( word def -- )
[ ] like over changed-definition [ ] like >>def drop ;
over unxref
over changed-definition
>>def
dup crossref? [ dup xref ] when drop ;
: changed-effect ( word -- ) : changed-effect ( word -- )
[ dup changed-effects get set-in-unit ] [ dup changed-effects get set-in-unit ]
@ -228,10 +198,9 @@ M: word set-where swap "loc" set-word-prop ;
M: word forget* M: word forget*
dup "forgotten" word-prop [ drop ] [ dup "forgotten" word-prop [ drop ] [
[ delete-xref ]
[ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ] [ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ]
[ t "forgotten" set-word-prop ] [ t "forgotten" set-word-prop ]
tri bi
] if ; ] if ;
M: word hashcode* M: word hashcode*
@ -239,6 +208,4 @@ M: word hashcode*
M: word literalize <wrapper> ; M: word literalize <wrapper> ;
: xref-words ( -- ) all-words [ xref ] each ;
INSTANCE: word definition INSTANCE: word definition