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
Slava Pestov
parent
dea3987ca5
commit
48e70b65fa
|
|
@ -16,13 +16,6 @@ SYMBOL: bootstrap-time
|
|||
vm file-name os windows? [ "." split1-last drop ] when
|
||||
".image" append resource-path ;
|
||||
|
||||
: do-crossref ( -- )
|
||||
"Cross-referencing..." print flush
|
||||
H{ } clone crossref set-global
|
||||
xref-words
|
||||
xref-generics
|
||||
xref-sources ;
|
||||
|
||||
: load-components ( -- )
|
||||
"include" "exclude"
|
||||
[ get-global " " split harvest ] bi@
|
||||
|
|
@ -68,8 +61,6 @@ SYMBOL: bootstrap-time
|
|||
|
||||
(command-line) parse-command-line
|
||||
|
||||
do-crossref
|
||||
|
||||
! Set dll paths
|
||||
os wince? [ "windows.ce" require ] when
|
||||
os winnt? [ "windows.nt" require ] when
|
||||
|
|
|
|||
|
|
@ -17,8 +17,3 @@ HELP: xref-article
|
|||
{ $values { "topic" "an article name or a word" } }
|
||||
{ $description "Sets the " { $link article-parent } " of each child of this article." }
|
||||
$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 ;
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
USING: arrays definitions generic assocs math fry
|
||||
io kernel namespaces prettyprint prettyprint.sections
|
||||
|
|
@ -12,9 +12,6 @@ IN: help.crossref
|
|||
: article-children ( topic -- seq )
|
||||
{ $subsection } article-links ;
|
||||
|
||||
M: link uses
|
||||
{ $subsection $link $see-also } article-links ;
|
||||
|
||||
: help-path ( topic -- seq )
|
||||
[ article-parent ] follow rest ;
|
||||
|
||||
|
|
@ -22,10 +19,7 @@ M: link uses
|
|||
article-children [ set-article-parent ] with each ;
|
||||
|
||||
: xref-article ( topic -- )
|
||||
dup >link xref dup set-article-parents ;
|
||||
|
||||
: unxref-article ( topic -- )
|
||||
>link unxref ;
|
||||
dup set-article-parents ;
|
||||
|
||||
: prev/next ( obj seq n -- obj' )
|
||||
[ [ index dup ] keep ] dip swap
|
||||
|
|
|
|||
|
|
@ -156,10 +156,7 @@ help-hook [ [ print-topic ] ] initialize
|
|||
error get (:help) ;
|
||||
|
||||
: remove-article ( name -- )
|
||||
dup articles get key? [
|
||||
dup unxref-article
|
||||
dup articles get delete-at
|
||||
] when drop ;
|
||||
articles get delete-at ;
|
||||
|
||||
: add-article ( article name -- )
|
||||
[ remove-article ] keep
|
||||
|
|
@ -167,7 +164,6 @@ help-hook [ [ print-topic ] ] initialize
|
|||
xref-article ;
|
||||
|
||||
: remove-word-help ( word -- )
|
||||
dup word-help [ dup unxref-article ] when
|
||||
f "help" set-word-prop ;
|
||||
|
||||
: set-word-help ( content word -- )
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators
|
|||
sequences math namespaces.private continuations.private
|
||||
concurrency.messaging quotations kernel.private words
|
||||
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
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
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 vocab-uses. }
|
||||
{ $subsection vocab-usage. }
|
||||
{ $see-also "definitions" "words" "see" } ;
|
||||
|
||||
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.
|
||||
{ $values { "word" "a word" } }
|
||||
{ $description "Prints an list of all callers of a word. This may include the word itself, if it is recursive." }
|
||||
{ $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
|
||||
|
|
|
|||
|
|
@ -11,3 +11,40 @@ M: integer foo + ;
|
|||
|
||||
[ t ] [ integer \ foo method \ + usage member? ] 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
|
||||
|
|
@ -1,9 +1,84 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs definitions io io.styles kernel prettyprint
|
||||
sorting see ;
|
||||
USING: words assocs definitions io io.pathnames io.styles kernel
|
||||
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
|
||||
|
||||
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 ] keep ] { } map>assoc ;
|
||||
|
||||
|
|
@ -15,3 +90,34 @@ IN: tools.crossref
|
|||
|
||||
: usage. ( word -- )
|
||||
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>
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
USING: tools.profiler.private tools.time help.markup help.syntax
|
||||
quotations io strings words definitions ;
|
||||
USING: tools.profiler.private tools.time tools.crossref
|
||||
help.markup help.syntax quotations io strings words definitions ;
|
||||
IN: tools.profiler
|
||||
|
||||
ARTICLE: "profiler-limitations" "Profiler limitations"
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors words sequences math prettyprint kernel arrays io
|
||||
io.styles namespaces assocs kernel.private strings combinators
|
||||
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
|
||||
|
||||
: profile ( quot -- )
|
||||
|
|
|
|||
|
|
@ -8,27 +8,6 @@ continuations compiler.errors init checksums checksums.crc32
|
|||
sets accessors generic definitions words ;
|
||||
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 )
|
||||
dup "-tests.factor" vocab-dir+ vocab-append-path dup
|
||||
[ dup exists? [ drop f ] unless ] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs definitions fry help.topics kernel
|
||||
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.search-tables ui.gadgets.wrappers ui.gestures ui.operations
|
||||
ui.pens.solid ui.images ;
|
||||
|
|
|
|||
|
|
@ -12,8 +12,6 @@ IN: bootstrap.primitives
|
|||
|
||||
"Creating primitives and basic runtime structures..." print flush
|
||||
|
||||
crossref off
|
||||
|
||||
H{ } clone sub-primitives set
|
||||
|
||||
"vocab:bootstrap/syntax.factor" parse-file
|
||||
|
|
|
|||
|
|
@ -110,8 +110,6 @@ TUPLE: yo-momma ;
|
|||
[ ] [ \ yo-momma forget ] unit-test
|
||||
[ ] [ \ <yo-momma> forget ] unit-test
|
||||
[ f ] [ \ yo-momma update-map get values memq? ] unit-test
|
||||
|
||||
[ f ] [ \ yo-momma crossref get at ] unit-test
|
||||
] with-compilation-unit
|
||||
|
||||
TUPLE: loc-recording ;
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ IN: compiler.units.tests
|
|||
enable-compiler
|
||||
] unit-test
|
||||
|
||||
! Notify observers even if compilation unit did nothing
|
||||
! Check that we notify observers
|
||||
SINGLETON: observer
|
||||
|
||||
observer add-definition-observer
|
||||
|
|
@ -47,7 +47,7 @@ SYMBOL: counter
|
|||
|
||||
M: observer definitions-changed 2drop global [ counter inc ] bind ;
|
||||
|
||||
[ ] with-compilation-unit
|
||||
[ gensym [ ] (( -- )) define-declared ] with-compilation-unit
|
||||
|
||||
[ 1 ] [ counter get-global ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -144,7 +144,7 @@ GENERIC: definitions-changed ( assoc obj -- )
|
|||
update-tuples
|
||||
process-forgotten-definitions
|
||||
modify-code-heap
|
||||
updated-definitions notify-definition-observers
|
||||
updated-definitions dup assoc-empty? [ drop ] [ notify-definition-observers ] if
|
||||
notify-error-observers ;
|
||||
|
||||
: with-nested-compilation-unit ( quot -- )
|
||||
|
|
|
|||
|
|
@ -10,21 +10,11 @@ $nl
|
|||
{ $subsection set-where }
|
||||
"Definitions can be removed:"
|
||||
{ $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:"
|
||||
{ $subsection definer }
|
||||
{ $subsection definition }
|
||||
{ $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"
|
||||
"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
|
||||
|
|
@ -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."
|
||||
{ $subsection "definition-protocol" }
|
||||
{ $subsection "definition-crossref" }
|
||||
{ $subsection "definition-checking" }
|
||||
{ $subsection "compilation-units" }
|
||||
"A parsing word to remove definitions:"
|
||||
|
|
@ -96,36 +85,3 @@ HELP: forget-all
|
|||
{ $values { "definitions" "a sequence of definition specifiers" } }
|
||||
{ $description "Forgets every definition in a sequence." }
|
||||
{ $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 } ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! 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
|
||||
|
||||
MIXIN: definition
|
||||
|
|
@ -53,29 +53,3 @@ SYMBOL: forgotten-definitions
|
|||
GENERIC: definer ( defspec -- start end )
|
||||
|
||||
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 ;
|
||||
|
|
|
|||
|
|
@ -133,69 +133,19 @@ M: f tag-and-f 4 ;
|
|||
[ 3.4 3 ] [ 3.4 tag-and-f ] unit-test
|
||||
|
||||
! 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 ] [
|
||||
\ / 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
|
||||
[ ] [ \ f \ generic-forget-test method "m" set ] 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
|
||||
|
||||
[ f ] [ f generic-forget-test-3 ] 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
|
||||
[ f ] [ f generic-forget-test ] unit-test
|
||||
|
||||
! erg's regression
|
||||
[ ] [
|
||||
|
|
|
|||
|
|
@ -123,8 +123,6 @@ M: method-body crossref?
|
|||
|
||||
PREDICATE: default-method < word "default" word-prop ;
|
||||
|
||||
M: default-method irrelevant? drop t ;
|
||||
|
||||
: <default-method> ( generic combination -- method )
|
||||
[ drop object bootstrap-word swap <method> ] [ make-default-method ] 2bi
|
||||
[ define ] [ drop t "default" set-word-prop ] [ drop ] 2tri ;
|
||||
|
|
@ -155,9 +153,6 @@ M: method-body forget*
|
|||
[ call-next-method ] bi
|
||||
] if ;
|
||||
|
||||
M: method-body smart-usage
|
||||
"method-generic" word-prop smart-usage ;
|
||||
|
||||
M: sequence update-methods ( class seq -- )
|
||||
implementors [
|
||||
[ changed-generic ] [ remake-generic drop ] 2bi
|
||||
|
|
@ -192,6 +187,3 @@ M: generic forget*
|
|||
|
||||
M: class forget-methods
|
||||
[ implementors ] [ [ swap method ] curry ] bi map forget-all ;
|
||||
|
||||
: xref-generics ( -- )
|
||||
all-words [ subwords [ xref ] each ] each ;
|
||||
|
|
|
|||
|
|
@ -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 irrelevant? drop t ;
|
||||
|
||||
: remember-engine ( word -- )
|
||||
generic get "engines" word-prop push ;
|
||||
|
||||
|
|
|
|||
|
|
@ -280,27 +280,6 @@ M: growable call-next-hooker call-next-method "growable " prepend ;
|
|||
V{ } my-var [ call-next-hooker ] with-variable
|
||||
] 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 ] [
|
||||
{ } \ nth effective-method nip \ sequence \ nth method eq?
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -264,7 +264,7 @@ print-use-hook [ [ ] ] initialize
|
|||
|
||||
: finish-parsing ( lines quot -- )
|
||||
file get
|
||||
[ record-form ]
|
||||
[ record-top-level-form ]
|
||||
[ record-definitions ]
|
||||
[ record-checksum ]
|
||||
tri ;
|
||||
|
|
|
|||
|
|
@ -11,9 +11,7 @@ $nl
|
|||
{ $subsection source-file }
|
||||
"Words intended for the parser:"
|
||||
{ $subsection record-checksum }
|
||||
{ $subsection record-form }
|
||||
{ $subsection xref-source }
|
||||
{ $subsection unxref-source }
|
||||
{ $subsection record-definitions }
|
||||
"Removing a source file from the database:"
|
||||
{ $subsection forget-source }
|
||||
"Updating the database:"
|
||||
|
|
@ -42,25 +40,6 @@ HELP: record-checksum
|
|||
{ $description "Records the CRC32 checksm of the source file's contents." }
|
||||
$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
|
||||
{ $description "Resets recorded modification times and CRC32 checksums for all loaded source files, creating a checkpoint for " { $link "tools.vocabs" } "." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
USING: arrays definitions generic assocs kernel math namespaces
|
||||
sequences strings vectors words quotations io io.files
|
||||
|
|
@ -11,29 +11,16 @@ SYMBOL: source-files
|
|||
|
||||
TUPLE: source-file
|
||||
path
|
||||
top-level-form
|
||||
checksum
|
||||
uses definitions ;
|
||||
definitions ;
|
||||
|
||||
: record-top-level-form ( quot file -- )
|
||||
(>>top-level-form) H{ } notify-definition-observers ;
|
||||
|
||||
: record-checksum ( lines source-file -- )
|
||||
[ 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 -- )
|
||||
new-definitions get >>definitions drop ;
|
||||
|
||||
|
|
@ -58,13 +45,8 @@ ERROR: invalid-source-file-path path ;
|
|||
M: pathname where string>> 1 2array ;
|
||||
|
||||
: forget-source ( path -- )
|
||||
[
|
||||
source-file
|
||||
[ unxref-source ]
|
||||
[ definitions>> [ keys forget-all ] each ] bi
|
||||
]
|
||||
[ source-files get delete-at ]
|
||||
bi ;
|
||||
source-files get delete-at*
|
||||
[ definitions>> [ keys forget-all ] each ] [ drop ] if ;
|
||||
|
||||
M: pathname forget*
|
||||
string>> forget-source ;
|
||||
|
|
|
|||
|
|
@ -290,10 +290,6 @@ HELP: define-temp
|
|||
"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?
|
||||
{ $values { "obj" object } { "?" "a boolean" } }
|
||||
{ $description "Tests if an object is a delimiter word declared by " { $link POSTPONE: delimiter } "." }
|
||||
|
|
|
|||
|
|
@ -63,52 +63,6 @@ FORGET: forgotten
|
|||
FORGET: 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
|
||||
[ x ] [ undefined? ] must-fail-with
|
||||
|
|
@ -122,26 +76,6 @@ DEFER: x
|
|||
[ ] [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] 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 [
|
||||
[ forget ] with-compilation-unit
|
||||
] when*
|
||||
|
|
@ -191,8 +125,3 @@ SYMBOL: quot-uses-b
|
|||
keys [ "forgotten" word-prop ] any?
|
||||
] filter
|
||||
] unit-test
|
||||
|
||||
[ { } ] [
|
||||
crossref get keys
|
||||
[ word? ] filter [ "forgotten" word-prop ] filter
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -62,33 +62,7 @@ SYMBOL: bootstrapping?
|
|||
GENERIC: crossref? ( word -- ? )
|
||||
|
||||
M: word crossref?
|
||||
dup "forgotten" word-prop [
|
||||
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 ;
|
||||
dup "forgotten" word-prop [ drop f ] [ vocabulary>> >boolean ] if ;
|
||||
|
||||
SYMBOL: compiled-crossref
|
||||
|
||||
|
|
@ -132,11 +106,7 @@ GENERIC: subwords ( word -- seq )
|
|||
M: word subwords drop f ;
|
||||
|
||||
: define ( word def -- )
|
||||
[ ] like
|
||||
over unxref
|
||||
over changed-definition
|
||||
>>def
|
||||
dup crossref? [ dup xref ] when drop ;
|
||||
over changed-definition [ ] like >>def drop ;
|
||||
|
||||
: changed-effect ( word -- )
|
||||
[ dup changed-effects get set-in-unit ]
|
||||
|
|
@ -228,10 +198,9 @@ M: word set-where swap "loc" set-word-prop ;
|
|||
|
||||
M: word forget*
|
||||
dup "forgotten" word-prop [ drop ] [
|
||||
[ delete-xref ]
|
||||
[ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ]
|
||||
[ t "forgotten" set-word-prop ]
|
||||
tri
|
||||
bi
|
||||
] if ;
|
||||
|
||||
M: word hashcode*
|
||||
|
|
@ -239,6 +208,4 @@ M: word hashcode*
|
|||
|
||||
M: word literalize <wrapper> ;
|
||||
|
||||
: xref-words ( -- ) all-words [ xref ] each ;
|
||||
|
||||
INSTANCE: word definition
|
||||
Loading…
Reference in New Issue