From 2d3298d611ab2fd1dcdfa2b7577928299d8de9bf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 4 Feb 2008 23:30:59 -0600 Subject: [PATCH] Method usages cleanup --- core/bootstrap/image/image.factor | 8 +------- core/bootstrap/stage2.factor | 1 + core/compiler/units/units-docs.factor | 9 +-------- core/compiler/units/units.factor | 5 ----- core/definitions/definitions-docs.factor | 4 +--- core/definitions/definitions-tests.factor | 4 +++- core/generic/generic-tests.factor | 2 +- core/generic/generic.factor | 13 ++++++++----- core/generic/standard/standard.factor | 2 +- core/inference/inference.factor | 11 +++++++---- core/optimizer/backend/backend.factor | 2 +- core/parser/parser-docs.factor | 4 +--- core/parser/parser-tests.factor | 4 ++-- core/parser/parser.factor | 10 +++------- core/source-files/source-files.factor | 14 ++++++++++++++ core/vocabs/loader/loader-tests.factor | 2 +- core/words/words-tests.factor | 3 ++- extra/tools/browser/browser.factor | 2 +- extra/tools/crossref/crossref.factor | 17 +---------------- 19 files changed, 50 insertions(+), 67 deletions(-) mode change 100644 => 100755 core/compiler/units/units-docs.factor diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 60e73cb249..3dadee5193 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -203,14 +203,8 @@ M: f ' ! Words -DEFER: emit-word - -: emit-generic ( generic -- ) - dup "default-method" word-prop method-word emit-word - "methods" word-prop [ nip method-word emit-word ] assoc-each ; - : emit-word ( word -- ) - dup generic? [ dup emit-generic ] when + dup subwords [ emit-word ] each [ dup hashcode ' , dup word-name ' , diff --git a/core/bootstrap/stage2.factor b/core/bootstrap/stage2.factor index 7a0fab8a99..f3483add57 100755 --- a/core/bootstrap/stage2.factor +++ b/core/bootstrap/stage2.factor @@ -24,6 +24,7 @@ IN: bootstrap.stage2 "Cross-referencing..." print flush H{ } clone crossref set-global xref-words + xref-generics xref-sources ] unless diff --git a/core/compiler/units/units-docs.factor b/core/compiler/units/units-docs.factor old mode 100644 new mode 100755 index 363b5b5014..99124d40ae --- a/core/compiler/units/units-docs.factor +++ b/core/compiler/units/units-docs.factor @@ -28,9 +28,7 @@ HELP: redefine-error HELP: remember-definition { $values { "definition" "a definition specifier" } { "loc" "a " { $snippet "{ path line# }" } " pair" } } -{ $description "Saves the location of a definition and associates this definition with the current source file." -$nl -"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ; +{ $description "Saves the location of a definition and associates this definition with the current source file." } ; HELP: old-definitions { $var-description "Stores an assoc where the keys form the set of definitions which were defined by " { $link file } " the most recent time it was loaded." } ; @@ -38,11 +36,6 @@ HELP: old-definitions HELP: new-definitions { $var-description "Stores an assoc where the keys form the set of definitions which were defined so far by the current parsing of " { $link file } "." } ; -HELP: forward-error -{ $values { "word" word } } -{ $description "Throws a " { $link forward-error } "." } -{ $description "Indicates a word is being referenced prior to the location of its most recent definition. This can only happen if a source file is loaded, and subsequently edited such that two dependent definitions are reversed." } ; - HELP: with-compilation-unit { $values { "quot" quotation } } { $description "Calls a quotation in a new compilation unit. The quotation can define new words and classes, as well as forget words. When the quotation returns, any changed words are recompiled, and changes are applied atomically." } diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 68e1a79185..242ed9854a 100755 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -26,11 +26,6 @@ TUPLE: redefine-error def ; over new-definitions get first key? [ dup redefine-error ] when new-definitions get second (remember-definition) ; -TUPLE: forward-error word ; - -: forward-error ( word -- ) - \ forward-error construct-boa throw ; - : forward-reference? ( word -- ? ) dup old-definitions get assoc-stack [ new-definitions get assoc-stack not ] diff --git a/core/definitions/definitions-docs.factor b/core/definitions/definitions-docs.factor index eec88bba0c..d855a14be9 100755 --- a/core/definitions/definitions-docs.factor +++ b/core/definitions/definitions-docs.factor @@ -52,9 +52,7 @@ $nl $nl "If the parser did not have special checks for this case, then the modified source file would still load, because when the definition of " { $snippet "hello-world" } " on line 4 is being parsed, the " { $snippet "world" } " word is already present in the dictionary from an earlier run. The developer would then not discover this mistake until attempting to load the source file into a fresh image." $nl -"Since this is undesirable, the parser explicitly raises an error if a source file refers to a word which is in the dictionary, but defined after it is used." -{ $subsection forward-error } -"If a source file raises a " { $link forward-error } " when loaded into a development image, then it would have raised a " { $link no-word } " error when loaded into a fresh image." +"Since this is undesirable, the parser explicitly raises a " { $link no-word } " error if a source file refers to a word which is in the dictionary, but defined after it is used." $nl "The parser also catches duplicate definitions. If an artifact is defined twice in the same source file, the earlier definition will never be accessible, and this is almost always a mistake, perhaps due to a bad choice of word names, or a copy and paste error. The parser raises an error in this case." { $subsection redefine-error } ; diff --git a/core/definitions/definitions-tests.factor b/core/definitions/definitions-tests.factor index a4cb4de902..f0b0888052 100755 --- a/core/definitions/definitions-tests.factor +++ b/core/definitions/definitions-tests.factor @@ -6,6 +6,8 @@ TUPLE: combination-1 ; M: combination-1 perform-combination 2drop { } [ ] each [ ] ; +M: combination-1 make-default-method 2drop [ "No method" throw ] ; + SYMBOL: generic-1 [ @@ -20,7 +22,7 @@ SYMBOL: generic-1 ] with-compilation-unit ] unit-test -GENERIC: some-generic +GENERIC: some-generic ( a -- b ) USE: arrays diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index f0d5bf3063..f1e1ebd6d2 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -177,7 +177,7 @@ M: f tag-and-f 4 ; TUPLE: debug-combination ; M: debug-combination make-default-method - 2drop [ "Oops" throw ] when ; + 2drop [ "Oops" throw ] ; M: debug-combination perform-combination drop diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 2100f49423..453d72effb 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -73,7 +73,8 @@ M: method-body stack-effect : ( quot class generic -- word ) [ make-method-def ] 2keep method-word-name f - dup rot define ; + dup rot define + dup xref ; : ( quot class generic -- method ) check-method @@ -135,12 +136,14 @@ M: assoc update-methods ( assoc -- ) make-generic ] if ; -: subwords ( generic -- seq ) +GENERIC: subwords ( word -- seq ) + +M: word subwords drop f ; + +M: generic subwords dup "methods" word-prop values swap "default-method" word-prop add [ method-word ] map ; : xref-generics ( -- ) - all-words - [ generic? ] subset - [ subwords [ xref ] each ] each ; + all-words [ subwords [ xref ] each ] each ; diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index d52208ccbf..88f6a05bc2 100755 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -91,7 +91,7 @@ TUPLE: no-method object generic ; : class-hash-dispatch-quot ( methods quot picker -- quot ) >r >r hash-methods r> map - hash-dispatch-quot r> [ class-hash ] rot 3append ; + hash-dispatch-quot r> [ class-hash ] rot 3append ; inline : big-generic ( methods -- quot ) [ small-generic ] picker class-hash-dispatch-quot ; diff --git a/core/inference/inference.factor b/core/inference/inference.factor index 0fc344dd85..3f52eaadf4 100755 --- a/core/inference/inference.factor +++ b/core/inference/inference.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2004, 2007 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: inference.backend inference.state inference.dataflow inference.known-words inference.transforms inference.errors -sequences prettyprint io effects kernel namespaces quotations -words vocabs ; +kernel io effects namespaces sequences quotations vocabs +generic words ; IN: inference GENERIC: infer ( quot -- effect ) @@ -28,4 +28,7 @@ M: callable dataflow-with ] with-infer nip ; : forget-errors ( -- ) - all-words [ f "no-effect" set-word-prop ] each ; + all-words [ + dup subwords [ f "no-effect" set-word-prop ] each + f "no-effect" set-word-prop + ] each ; diff --git a/core/optimizer/backend/backend.factor b/core/optimizer/backend/backend.factor index 27b1b1e0ec..9d75346091 100755 --- a/core/optimizer/backend/backend.factor +++ b/core/optimizer/backend/backend.factor @@ -256,7 +256,7 @@ M: #dispatch optimize-node* tuck dispatching-class dup [ swap [ 2array ] 2keep method method-word - dup word-def flat-length 5 >= + dup word-def flat-length 6 >= [ 1quotation ] [ word-def ] if ] [ 2drop t t diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 30e259c033..d8d6c9b7bc 100755 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -202,9 +202,7 @@ HELP: location HELP: save-location { $values { "definition" "a definition specifier" } } -{ $description "Saves the location of a definition and associates this definition with the current source file." -$nl -"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ; +{ $description "Saves the location of a definition and associates this definition with the current source file." } ; HELP: parser-notes { $var-description "A boolean controlling whether the parser will print various notes and warnings. Switched on by default. If a source file is being run for its effect on the " { $link stdio } " stream, this variable should be switched off, to prevent parser notes from polluting the output." } ; diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index b00e8e26b4..f503528a24 100755 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -342,7 +342,7 @@ IN: temporary [ "IN: temporary \\ class-fwd-test" "redefining-a-class-3" parse-stream drop - ] catch [ forward-error? ] is? + ] catch [ no-word? ] is? ] unit-test [ ] [ @@ -354,7 +354,7 @@ IN: temporary [ "IN: temporary \\ class-fwd-test" "redefining-a-class-3" parse-stream drop - ] catch [ forward-error? ] is? + ] catch [ no-word? ] is? ] unit-test [ t ] [ diff --git a/core/parser/parser.factor b/core/parser/parser.factor index ffecf9493e..6d7ad47843 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -235,7 +235,8 @@ M: no-word summary : no-word ( name -- newword ) dup \ no-word construct-boa - swap words-named word-restarts throw-restarts + swap words-named [ forward-reference? not ] subset + word-restarts throw-restarts dup word-vocabulary (use+) ; : check-forward ( str word -- word ) @@ -244,7 +245,7 @@ M: no-word summary dup use get [ at ] with map [ ] subset [ forward-reference? not ] find nip - [ ] [ forward-error ] ?if + [ ] [ no-word ] ?if ] [ nip ] if ; @@ -415,11 +416,6 @@ SYMBOL: interactive-vocabs over stack. ] when 2drop ; -: outside-usages ( seq -- usages ) - dup [ - over usage [ pathname? not ] subset seq-diff - ] curry { } map>assoc ; - : filter-moved ( assoc -- newassoc ) [ drop where dup [ first ] when diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index c974145928..64ae2e376e 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -96,3 +96,17 @@ SYMBOL: file source-file-definitions old-definitions set [ ] [ file get rollback-source-file ] cleanup ] with-scope ; inline + +: smart-usage ( word -- definitions ) + \ f or usage [ + dup method-body? [ + "method" word-prop + { method-specializer method-generic } get-slots + 2array + ] when + ] map ; + +: outside-usages ( seq -- usages ) + dup [ + over smart-usage [ pathname? not ] subset seq-diff + ] curry { } map>assoc ; diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index f38276d318..560affa566 100755 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -79,7 +79,7 @@ IN: temporary "resource:core/vocabs/loader/test/a/a.factor" parse-stream - ] catch [ forward-error? ] is? + ] catch [ no-word? ] is? ] unit-test 0 "count-me" set-global diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 2455250dc9..35a2421e71 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -87,7 +87,8 @@ FORGET: foe ] unit-test [ t ] [ - \ * usage [ word? ] subset [ interned? not ] subset empty? + \ * usage [ word? ] subset + [ dup interned? swap method-body? or ] all? ] unit-test DEFER: calls-a-gensym diff --git a/extra/tools/browser/browser.factor b/extra/tools/browser/browser.factor index 370e55eb97..dabc37e5de 100755 --- a/extra/tools/browser/browser.factor +++ b/extra/tools/browser/browser.factor @@ -238,7 +238,7 @@ C: vocab-author : vocab-xref ( vocab quot -- vocabs ) >r dup vocab-name swap words r> map [ [ word? ] subset [ word-vocabulary ] map ] map>set - remove [ vocab ] map ; inline + remove [ ] subset [ vocab ] map ; inline : vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ; diff --git a/extra/tools/crossref/crossref.factor b/extra/tools/crossref/crossref.factor index 663df61926..f6561e9f26 100755 --- a/extra/tools/crossref/crossref.factor +++ b/extra/tools/crossref/crossref.factor @@ -3,7 +3,7 @@ USING: arrays definitions assocs io kernel math namespaces prettyprint sequences strings io.styles words generic tools.completion quotations parser inspector -sorting hashtables vocabs ; +sorting hashtables vocabs parser source-files ; IN: tools.crossref : synopsis-alist ( definitions -- alist ) @@ -12,21 +12,6 @@ IN: tools.crossref : definitions. ( alist -- ) [ write-object nl ] assoc-each ; -: (method-usage) ( word generic -- methods ) - tuck methods - [ second uses member? ] with subset keys - swap [ 2array ] curry map ; - -: method-usage ( word seq -- methods ) - [ generic? ] subset [ (method-usage) ] with map concat ; - -: compound-usage ( words -- seq ) - [ generic? not ] subset ; - -: smart-usage ( word -- definitions ) - \ f or - dup usage dup compound-usage -rot method-usage append ; - : usage. ( word -- ) smart-usage synopsis-alist sort-keys definitions. ;