Clean up some code in preparation for a refactoring

release
Slava Pestov 2010-01-30 05:28:55 +13:00
parent 7189342c19
commit fa4f7d8ccf
5 changed files with 17 additions and 44 deletions

View File

@ -42,7 +42,7 @@ SYMBOL: compiled
#! If a word's stack effect changed, recompile all words #! If a word's stack effect changed, recompile all words
#! that have compiled calls to it. #! that have compiled calls to it.
dup recompile-callers? dup recompile-callers?
[ compiled-usage keys [ queue-compile ] each ] [ drop ] if ; [ effect-dependencies-of keys [ queue-compile ] each ] [ drop ] if ;
: compiler-message ( string -- ) : compiler-message ( string -- )
"trace-compilation" get [ global [ print flush ] bind ] [ drop ] if ; "trace-compilation" get [ global [ print flush ] bind ] [ drop ] if ;

View File

@ -13,15 +13,18 @@ SYMBOL: compiled-generic-crossref
compiled-generic-crossref [ H{ } clone ] initialize compiled-generic-crossref [ H{ } clone ] initialize
: compiled-usage ( word -- assoc ) : effect-dependencies-of ( word -- assoc )
compiled-crossref get at ; compiled-crossref get at ;
: (compiled-usages) ( word -- assoc ) : definition-dependencies-of ( word -- assoc )
compiled-usage [ nip inlined-dependency dependency>= ] assoc-filter ; effect-dependencies-of [ nip definition-dependency dependency>= ] assoc-filter ;
: conditional-dependencies-of ( word -- assoc )
effect-dependencies-of [ nip conditional-dependency dependency>= ] assoc-filter ;
: compiled-usages ( assoc -- assocs ) : compiled-usages ( assoc -- assocs )
[ drop word? ] assoc-filter [ drop word? ] assoc-filter
[ [ drop (compiled-usages) ] { } assoc>map ] keep suffix ; [ [ drop definition-dependencies-of ] { } assoc>map ] keep suffix ;
: dependencies-satisfied? ( word cache -- ? ) : dependencies-satisfied? ( word cache -- ? )
[ "dependency-checks" word-prop ] dip [ "dependency-checks" word-prop ] dip
@ -30,8 +33,7 @@ compiled-generic-crossref [ H{ } clone ] initialize
: outdated-conditional-usages ( assoc -- assocs ) : outdated-conditional-usages ( assoc -- assocs )
H{ } clone '[ H{ } clone '[
drop drop
compiled-usage conditional-dependencies-of
[ nip conditional-dependency dependency>= ] assoc-filter
[ drop _ dependencies-satisfied? not ] assoc-filter [ drop _ dependencies-satisfied? not ] assoc-filter
] { } assoc>map ; ] { } assoc>map ;

View File

@ -1,30 +1 @@
IN: stack-checker.dependencies.tests
USING: tools.test stack-checker.dependencies words kernel namespaces
definitions ;
: computing-dependencies ( quot -- dependencies )
H{ } clone [ dependencies rot with-variable ] keep ;
inline
SYMBOL: a
SYMBOL: b
[ ] [ a called-dependency depends-on ] unit-test
[ H{ { a called-dependency } } ] [
[ a called-dependency depends-on ] computing-dependencies
] unit-test
[ H{ { a called-dependency } { b inlined-dependency } } ] [
[
a called-dependency depends-on b inlined-dependency depends-on
] computing-dependencies
] unit-test
[ H{ { a inlined-dependency } { b inlined-dependency } } ] [
[
a inlined-dependency depends-on
a called-dependency depends-on
b inlined-dependency depends-on
] computing-dependencies
] unit-test

View File

@ -8,17 +8,17 @@ IN: stack-checker.dependencies
! Words that the current quotation depends on ! Words that the current quotation depends on
SYMBOL: dependencies SYMBOL: dependencies
SYMBOLS: inlined-dependency conditional-dependency flushed-dependency called-dependency ; SYMBOLS: effect-dependency conditional-dependency definition-dependency ;
: index>= ( obj1 obj2 seq -- ? ) : index>= ( obj1 obj2 seq -- ? )
[ index ] curry bi@ >= ; [ index ] curry bi@ >= ;
: dependency>= ( how1 how2 -- ? ) : dependency>= ( how1 how2 -- ? )
{ called-dependency conditional-dependency flushed-dependency inlined-dependency } { effect-dependency conditional-dependency definition-dependency }
index>= ; index>= ;
: strongest-dependency ( how1 how2 -- how ) : strongest-dependency ( how1 how2 -- how )
[ called-dependency or ] bi@ [ dependency>= ] most ; [ effect-dependency or ] bi@ [ dependency>= ] most ;
: depends-on ( word how -- ) : depends-on ( word how -- )
over primitive? [ 2drop ] [ over primitive? [ 2drop ] [
@ -28,14 +28,14 @@ SYMBOLS: inlined-dependency conditional-dependency flushed-dependency called-dep
] if ; ] if ;
: depends-on-effect ( word -- ) : depends-on-effect ( word -- )
called-dependency depends-on ; effect-dependency depends-on ;
: depends-on-definition ( word -- )
inlined-dependency depends-on ;
: depends-on-conditionally ( word -- ) : depends-on-conditionally ( word -- )
conditional-dependency depends-on ; conditional-dependency depends-on ;
: depends-on-definition ( word -- )
definition-dependency depends-on ;
! Generic words that the current quotation depends on ! Generic words that the current quotation depends on
SYMBOL: generic-dependencies SYMBOL: generic-dependencies

View File

@ -40,7 +40,7 @@ IN: tools.profiler
: profiler-usage ( word -- words ) : profiler-usage ( word -- words )
[ smart-usage [ word? ] filter ] [ smart-usage [ word? ] filter ]
[ compiled-generic-usage keys ] [ compiled-generic-usage keys ]
[ compiled-usage keys ] [ effect-dependencies-of keys ]
tri 3append prune ; tri 3append prune ;
: usage-counters ( word -- alist ) : usage-counters ( word -- alist )