From 014d2ea31cd523285b7d052a02d76ee31db17cf4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Jun 2008 20:47:09 -0500 Subject: [PATCH] Cleaning up and debugging corss-referencing --- core/compiler/compiler.factor | 2 +- core/compiler/units/units.factor | 4 +-- core/definitions/definitions.factor | 12 ++++++- core/generic/generic.factor | 6 ++++ .../standard/engines/tuple/tuple.factor | 7 ++-- core/generic/standard/standard-tests.factor | 24 +++++++++++++- core/inference/backend/backend.factor | 24 +++++++++++++- core/inference/inference-tests.factor | 32 ++++++++++++++++--- core/words/words.factor | 25 ++------------- extra/editors/editors.factor | 2 +- extra/tools/crossref/crossref.factor | 2 +- extra/tools/profiler/profiler-docs.factor | 2 +- extra/tools/profiler/profiler.factor | 2 +- extra/ui/tools/search/search.factor | 2 +- 14 files changed, 106 insertions(+), 40 deletions(-) diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index ef00e94dd5..8c653b866e 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -35,7 +35,7 @@ IN: compiler [ swap save-effect ] [ compiled-unxref ] [ - dup compiled-crossref? + dup crossref? [ dependencies get compiled-xref ] [ drop ] if ] tri ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index c2e84429cf..6acd3a6415 100755 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -66,7 +66,7 @@ GENERIC: definitions-changed ( assoc obj -- ) : compile ( words -- ) recompile-hook get call - dup [ drop compiled-crossref? ] assoc-contains? + dup [ drop crossref? ] assoc-contains? modify-code-heap ; SYMBOL: outdated-tuples @@ -82,7 +82,7 @@ SYMBOL: update-tuples-hook : finish-compilation-unit ( -- ) call-recompile-hook call-update-tuples-hook - dup [ drop compiled-crossref? ] assoc-contains? modify-code-heap + dup [ drop crossref? ] assoc-contains? modify-code-heap ; : with-nested-compilation-unit ( quot -- ) diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index 459512b83a..122205eb26 100755 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -47,7 +47,17 @@ M: object uses drop f ; : xref ( defspec -- ) dup uses crossref get add-vertex ; -: usage ( defspec -- seq ) \ f or crossref get at keys ; +: 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 ; diff --git a/core/generic/generic.factor b/core/generic/generic.factor index b9a556e316..c99de94ded 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -117,6 +117,9 @@ M: method-spec definition M: method-spec forget* first2 method forget* ; +M: method-spec smart-usage + second smart-usage ; + M: method-body definer drop \ M: \ ; ; @@ -134,6 +137,9 @@ M: method-body forget* [ t "forgotten" set-word-prop ] bi ] if ; +M: method-body smart-usage + "method-generic" word-prop smart-usage ; + : implementors* ( classes -- words ) all-words [ "methods" word-prop keys diff --git a/core/generic/standard/engines/tuple/tuple.factor b/core/generic/standard/engines/tuple/tuple.factor index 51ea4f8225..24fb8ba4f4 100644 --- a/core/generic/standard/engines/tuple/tuple.factor +++ b/core/generic/standard/engines/tuple/tuple.factor @@ -4,7 +4,7 @@ USING: kernel classes.tuple.private hashtables assocs sorting accessors combinators sequences slots.private math.parser words effects namespaces generic generic.standard.engines classes.algebra math math.private kernel.private -quotations arrays ; +quotations arrays definitions ; IN: generic.standard.engines.tuple TUPLE: echelon-dispatch-engine n methods ; @@ -64,8 +64,9 @@ M: engine-word stack-effect [ extra-values ] [ stack-effect ] bi dup [ clone [ length + ] change-in ] [ 2drop f ] if ; -M: engine-word compiled-crossref? - drop t ; +M: engine-word crossref? drop t ; + +M: engine-word irrelevant? drop t ; : remember-engine ( word -- ) generic get "engines" word-prop push ; diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor index 1bff9ae15d..66f191a93f 100644 --- a/core/generic/standard/standard-tests.factor +++ b/core/generic/standard/standard-tests.factor @@ -3,7 +3,8 @@ USING: tools.test math math.functions math.constants generic.standard strings sequences arrays kernel accessors words float-arrays byte-arrays bit-arrays parser namespaces quotations inference vectors growable hashtables sbufs -prettyprint byte-vectors bit-vectors float-vectors ; +prettyprint byte-vectors bit-vectors float-vectors definitions +generic sets graphs assocs ; GENERIC: lo-tag-test @@ -287,3 +288,24 @@ M: sbuf no-stack-effect-decl ; [ ] [ \ no-stack-effect-decl see ] unit-test [ ] [ \ no-stack-effect-decl word-def . ] unit-test + +! Cross-referencing with generic words +TUPLE: xref-tuple-1 ; +TUPLE: xref-tuple-2 < xref-tuple-1 ; + +: (xref-test) 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 diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor index c49e7fda8a..9a0f4c772e 100755 --- a/core/inference/backend/backend.factor +++ b/core/inference/backend/backend.factor @@ -4,7 +4,7 @@ USING: inference.dataflow inference.state arrays generic io io.streams.string kernel math namespaces parser prettyprint sequences strings vectors words quotations effects classes continuations debugger assocs combinators compiler.errors -generic.standard.engines.tuple accessors math.order ; +generic.standard.engines.tuple accessors math.order definitions ; IN: inference.backend : recursive-label ( word -- label/f ) @@ -21,6 +21,28 @@ M: engine-word inline? M: word inline? "inline" word-prop ; +SYMBOL: visited + +: reset-on-redefine { "inferred-effect" "no-effect" } ; inline + +: (redefined) ( word -- ) + dup visited get key? [ drop ] [ + [ reset-on-redefine reset-props ] + [ dup visited get set-at ] + [ + crossref get at keys + [ word? ] filter + [ + [ reset-on-redefine [ word-prop ] with contains? ] + [ inline? ] + bi or + ] filter + [ (redefined) ] each + ] tri + ] if ; + +M: word redefined H{ } clone visited [ (redefined) ] with-variable ; + : local-recursive-state ( -- assoc ) recursive-state get dup keys [ dup word? [ inline? ] when not ] find drop diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor index 0d3eb03cf4..4ce354bdcc 100755 --- a/core/inference/inference-tests.factor +++ b/core/inference/inference-tests.factor @@ -549,10 +549,34 @@ ERROR: custom-error ; { 1 0 } [ [ ] map-children ] must-infer-as ! Corner case -! [ [ [ f dup ] [ dup ] [ ] unfold ] infer ] must-fail +[ [ [ f dup ] [ dup ] [ ] unfold ] infer ] must-fail -! [ [ [ f dup ] [ ] [ ] while ] infer ] must-fail +[ [ [ f dup ] [ ] [ ] while ] infer ] must-fail -! : erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline +: erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline -! [ [ erg's-inference-bug ] infer ] must-fail +[ [ erg's-inference-bug ] infer ] must-fail + +: inference-invalidation-a ; +: inference-invalidation-b [ inference-invalidation-a ] dip call ; inline +: inference-invalidation-c [ + ] inference-invalidation-b ; + +[ 7 ] [ 4 3 inference-invalidation-c ] unit-test + +{ 2 1 } [ inference-invalidation-c ] must-infer-as + +[ ] [ "IN: inference.tests : inference-invalidation-a 1 2 ;" eval ] unit-test + +[ 3 ] [ inference-invalidation-c ] unit-test + +{ 0 1 } [ inference-invalidation-c ] must-infer-as + +GENERIC: inference-invalidation-d ( obj -- ) + +M: object inference-invalidation-d inference-invalidation-c 2drop ; + +\ inference-invalidation-d must-infer + +[ ] [ "IN: inference.tests : inference-invalidation-a ;" eval ] unit-test + +[ [ inference-invalidation-d ] infer ] must-fail diff --git a/core/words/words.factor b/core/words/words.factor index 5549f98010..bc4b2ede72 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -102,7 +102,7 @@ SYMBOL: compiled-crossref compiled-crossref global [ H{ } assoc-like ] change-at : compiled-xref ( word dependencies -- ) - [ drop compiled-crossref? ] assoc-filter + [ drop crossref? ] assoc-filter 2dup "compiled-uses" set-word-prop compiled-crossref get add-vertex* ; @@ -125,28 +125,9 @@ SYMBOL: +called+ compiled-usage [ nip +inlined+ eq? ] assoc-filter update ] with each keys ; - - -: redefined ( word -- ) - H{ } clone visited [ (redefined) ] with-variable ; +M: object redefined drop ; : define ( word def -- ) [ ] like diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index a15a12830c..25bd560d42 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -53,7 +53,7 @@ M: object find-parse-error : fix ( word -- ) [ "Fixing " write pprint " and all usages..." print nl ] - [ [ usage ] keep prefix ] bi + [ [ smart-usage ] keep prefix ] bi [ [ "Editing " write . ] [ diff --git a/extra/tools/crossref/crossref.factor b/extra/tools/crossref/crossref.factor index f4515a9ebe..3ff22cb0c6 100755 --- a/extra/tools/crossref/crossref.factor +++ b/extra/tools/crossref/crossref.factor @@ -7,7 +7,7 @@ sorting hashtables vocabs parser source-files ; IN: tools.crossref : usage. ( word -- ) - usage sorted-definitions. ; + smart-usage sorted-definitions. ; : words-matching ( str -- seq ) all-words [ dup word-name ] { } map>assoc completions ; diff --git a/extra/tools/profiler/profiler-docs.factor b/extra/tools/profiler/profiler-docs.factor index 50bbc527d1..69edf1a7e0 100755 --- a/extra/tools/profiler/profiler-docs.factor +++ b/extra/tools/profiler/profiler-docs.factor @@ -44,7 +44,7 @@ HELP: vocab-profile. HELP: usage-profile. { $values { "word" word } } { $description "Prints a table of call counts from the most recent invocation of " { $link profile } ", for words which directly call " { $snippet "word" } " only." } -{ $notes "This word obtains the list of static usages with the " { $link usage } " word, and is not aware of dynamic call history. Consider the following scenario. A word " { $snippet "X" } " can execute word " { $snippet "Y" } " in a conditional branch, and " { $snippet "X" } " is executed many times during the profiling run, but this particular branch executing " { $snippet "Y" } " is never taken. However, some other word does execute " { $snippet "Y" } " multiple times. Then " { $snippet "\\ Y usage-profile." } " will list a number of calls to " { $snippet "X" } ", even though " { $snippet "Y" } " was never executed " { $emphasis "from" } " " { $snippet "X" } "." } +{ $notes "This word obtains the list of static usages with the " { $link smart-usage } " word, and is not aware of dynamic call history. Consider the following scenario. A word " { $snippet "X" } " can execute word " { $snippet "Y" } " in a conditional branch, and " { $snippet "X" } " is executed many times during the profiling run, but this particular branch executing " { $snippet "Y" } " is never taken. However, some other word does execute " { $snippet "Y" } " multiple times. Then " { $snippet "\\ Y usage-profile." } " will list a number of calls to " { $snippet "X" } ", even though " { $snippet "Y" } " was never executed " { $emphasis "from" } " " { $snippet "X" } "." } { $examples { $code "\\ + usage-profile." } } ; HELP: vocabs-profile. diff --git a/extra/tools/profiler/profiler.factor b/extra/tools/profiler/profiler.factor index 6a5fce6281..4ae3666829 100755 --- a/extra/tools/profiler/profiler.factor +++ b/extra/tools/profiler/profiler.factor @@ -58,7 +58,7 @@ M: method-body (profile.) "Call counts for words which call " write dup pprint ":" print - usage [ word? ] filter counters counters. ; + smart-usage [ word? ] filter counters counters. ; : vocabs-profile. ( -- ) "Call counts for all vocabularies:" print diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor index b18c0c1ad6..695727e314 100755 --- a/extra/ui/tools/search/search.factor +++ b/extra/ui/tools/search/search.factor @@ -94,7 +94,7 @@ M: live-search pref-dim* drop { 400 200 } ; "Words in " rot vocab-name append show-titled-popup ; : show-word-usage ( workspace word -- ) - "" over usage f + "" over smart-usage f "Words and methods using " rot word-name append show-titled-popup ;