From 181f11faa8c203d8d10e7b1b008dafd72dbce1cb Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 3 Oct 2011 15:49:49 -0700 Subject: [PATCH] Make M\ throw an error upon lookup failure. Change method -> ?lookup-method, lookup-method is the throwing version of ?lookup-method. Fixes #229. --- basis/classes/struct/struct-tests.factor | 4 ++-- basis/classes/struct/struct.factor | 4 ++-- basis/compiler/tests/redefine1.factor | 4 ++-- basis/compiler/tests/redefine3.factor | 12 ++++++------ basis/delegate/delegate.factor | 4 ++-- basis/math/intervals/intervals.factor | 2 +- .../partial-dispatch/partial-dispatch.factor | 2 +- basis/see/see.factor | 2 +- .../known-words/known-words.factor | 3 ++- basis/tools/profiler/profiler.factor | 2 +- core/classes/tuple/tuple-tests.factor | 12 ++++++------ core/classes/tuple/tuple.factor | 4 ++-- core/generic/generic.factor | 17 +++++++++++------ core/generic/hook/hook.factor | 5 +++-- core/generic/math/math.factor | 2 +- core/generic/single/single.factor | 6 ++++-- core/generic/standard/standard-tests.factor | 2 +- core/syntax/syntax.factor | 2 +- 18 files changed, 49 insertions(+), 40 deletions(-) diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 56d1cec21d..40fbf026e3 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -540,6 +540,6 @@ STRUCT: going-to-redefine { a uint } ; [ ] [ "IN: classes.struct.tests TUPLE: going-to-redefine b ;" eval( -- ) ] unit-test -[ f ] [ \ going-to-redefine \ clone method ] unit-test -[ f ] [ \ going-to-redefine \ struct-slot-values method ] unit-test +[ f ] [ \ going-to-redefine \ clone ?lookup-method ] unit-test +[ f ] [ \ going-to-redefine \ struct-slot-values ?lookup-method ] unit-test diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index db26f4d209..7a9b05aa67 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -196,7 +196,7 @@ M: struct-c-type base-type ; define-inline-method ; : forget-struct-slot-values-method ( class -- ) - \ struct-slot-values method forget ; + \ struct-slot-values ?lookup-method forget ; : clone-underlying ( struct -- byte-array ) binary-object memory>byte-array ; inline @@ -207,7 +207,7 @@ M: struct-c-type base-type ; define-inline-method ; : forget-clone-method ( class -- ) - \ clone method forget ; + \ clone ?lookup-method forget ; :: c-type-for-class ( class slots size align -- c-type ) struct-c-type new diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor index 6bb623cac4..c291194019 100644 --- a/basis/compiler/tests/redefine1.factor +++ b/basis/compiler/tests/redefine1.factor @@ -15,7 +15,7 @@ M: integer method-redefine-generic-1 3 + ; [ 7 ] [ method-redefine-test-1 ] unit-test -[ ] [ [ fixnum \ method-redefine-generic-1 method forget ] with-compilation-unit ] unit-test +[ ] [ [ fixnum \ method-redefine-generic-1 lookup-method forget ] with-compilation-unit ] unit-test [ 6 ] [ method-redefine-test-1 ] unit-test @@ -33,6 +33,6 @@ M: integer method-redefine-generic-2 3 + ; [ ] [ [ - fixnum string [ \ method-redefine-generic-2 method forget ] bi@ + fixnum string [ \ method-redefine-generic-2 lookup-method forget ] bi@ ] with-compilation-unit ] unit-test diff --git a/basis/compiler/tests/redefine3.factor b/basis/compiler/tests/redefine3.factor index 93b1e6fa92..b8915c84bb 100644 --- a/basis/compiler/tests/redefine3.factor +++ b/basis/compiler/tests/redefine3.factor @@ -18,18 +18,18 @@ M: empty-mixin sheeple drop "wake up" ; inline [ "sheeple" ] [ sheeple-test ] unit-test [ t ] [ \ sheeple-test optimized? ] unit-test -[ t ] [ object \ sheeple method \ sheeple-test compiled-use? ] unit-test -[ f ] [ empty-mixin \ sheeple method \ sheeple-test compiled-use? ] unit-test +[ t ] [ object \ sheeple lookup-method \ sheeple-test compiled-use? ] unit-test +[ f ] [ empty-mixin \ sheeple lookup-method \ sheeple-test compiled-use? ] unit-test [ ] [ "IN: compiler.tests.redefine3 USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test [ "wake up" ] [ sheeple-test ] unit-test -[ f ] [ object \ sheeple method \ sheeple-test compiled-use? ] unit-test -[ t ] [ empty-mixin \ sheeple method \ sheeple-test compiled-use? ] unit-test +[ f ] [ object \ sheeple lookup-method \ sheeple-test compiled-use? ] unit-test +[ t ] [ empty-mixin \ sheeple lookup-method \ sheeple-test compiled-use? ] unit-test [ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test [ "sheeple" ] [ sheeple-test ] unit-test [ t ] [ \ sheeple-test optimized? ] unit-test -[ t ] [ object \ sheeple method \ sheeple-test compiled-use? ] unit-test -[ f ] [ empty-mixin \ sheeple method \ sheeple-test compiled-use? ] unit-test +[ t ] [ object \ sheeple lookup-method \ sheeple-test compiled-use? ] unit-test +[ f ] [ empty-mixin \ sheeple lookup-method \ sheeple-test compiled-use? ] unit-test diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor index 7958f51bc3..ec005482d1 100644 --- a/basis/delegate/delegate.factor +++ b/basis/delegate/delegate.factor @@ -91,7 +91,7 @@ M: broadcast (consult-method-quot) \ protocol-consult word-prop delete-at ; : unconsult-method ( word consultation -- ) - [ class>> swap first method ] keep + [ class>> swap first lookup-method ] keep over [ over "consultation" word-prop eq? [ forget ] [ drop ] if @@ -124,7 +124,7 @@ M: consultation forget* assoc + [ [ dup 3array ] [ swap ?lookup-method ] 2bi ] with { } map>assoc [ nip ] assoc-filter [ def>> ] assoc-map [ nip length 1 = ] assoc-filter diff --git a/basis/see/see.factor b/basis/see/see.factor index 38a8a48934..839e7a5d05 100644 --- a/basis/see/see.factor +++ b/basis/see/see.factor @@ -224,7 +224,7 @@ M: word see* : seeing-implementors ( class -- seq ) dup implementors [ [ reader? ] [ writer? ] bi or not ] filter - [ method ] with map + [ ?lookup-method ] with map natural-sort ; : seeing-methods ( generic -- seq ) diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 0ef3976e62..bc7e28c2b0 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -25,6 +25,7 @@ stack-checker.transforms stack-checker.dependencies stack-checker.recursive-state stack-checker.row-polymorphism ; +QUALIFIED-WITH: generic.single.private gsp IN: stack-checker.known-words : infer-special ( word -- ) @@ -417,7 +418,7 @@ M: object infer-call* \ call bad-macro-input ; \ innermost-frame-executing { callstack } { object } define-primitive \ innermost-frame-scan { callstack } { fixnum } define-primitive \ jit-compile { quotation } { } define-primitive -\ lookup-method { object array } { word } define-primitive +\ gsp:lookup-method { object array } { word } define-primitive \ minor-gc { } { } define-primitive \ modify-code-heap { array object object } { } define-primitive \ nano-count { } { integer } define-primitive \ nano-count make-flushable diff --git a/basis/tools/profiler/profiler.factor b/basis/tools/profiler/profiler.factor index c79d8b443c..f002d95032 100644 --- a/basis/tools/profiler/profiler.factor +++ b/basis/tools/profiler/profiler.factor @@ -30,7 +30,7 @@ IN: tools.profiler all-words [ subwords ] cumulative-counters ; : methods-on ( class -- methods ) - dup implementors [ method ] with map ; + dup implementors [ lookup-method ] with map ; : class-counters ( -- alist ) classes [ methods-on ] cumulative-counters ; diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 45af82ea83..5132f1f027 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -476,7 +476,7 @@ must-fail-with : accessor-exists? ( name -- ? ) [ "forget-accessors-test" "classes.tuple.tests" lookup ] dip - ">>" append "accessors" lookup method >boolean ; + ">>" append "accessors" lookup ?lookup-method >boolean ; [ t ] [ "x" accessor-exists? ] unit-test [ t ] [ "y" accessor-exists? ] unit-test @@ -594,7 +594,7 @@ T{ reshape-test f "hi" } "tuple" set [ ] [ "IN: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" eval( -- ) ] unit-test -[ f ] [ \ reshape-test \ x<< method ] unit-test +[ f ] [ \ reshape-test \ x<< ?lookup-method ] unit-test [ "tuple" get 5 >>x ] must-fail @@ -678,7 +678,7 @@ SLOT: kex drop ] unit-test -[ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test +[ t ] [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test [ ] [ "IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test kex ;" @@ -686,7 +686,7 @@ SLOT: kex drop ] unit-test -[ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test +[ t ] [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test [ ] [ "IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; SLOT: kex M: change-slot-test kex>> drop 3 ;" @@ -694,8 +694,8 @@ SLOT: kex drop ] unit-test -[ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test -[ f ] [ \ change-slot-test \ kex>> method "reading" word-prop ] unit-test +[ t ] [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test +[ f ] [ \ change-slot-test \ kex>> ?lookup-method "reading" word-prop ] unit-test DEFER: redefine-tuple-twice diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 6360a9662c..f542fbe7fd 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -319,8 +319,8 @@ M: tuple-class reset-class [ dup "slots" word-prop [ name>> - [ reader-word method forget ] - [ writer-word method forget ] 2bi + [ reader-word ?lookup-method forget ] + [ writer-word ?lookup-method forget ] 2bi ] with each ] [ [ call-next-method ] diff --git a/core/generic/generic.factor b/core/generic/generic.factor index a733ac90fa..c360067fa3 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -25,9 +25,14 @@ M: generic definition drop f ; PREDICATE: method < word "method-generic" word-prop >boolean ; -: method ( class generic -- method/f ) +ERROR: method-lookup-failed class generic ; + +: ?lookup-method ( class generic -- method/f ) "methods" word-prop at ; +: lookup-method ( class generic -- method/* ) + 2dup ?lookup-method [ 2nip ] [ method-lookup-failed ] if* ; + method-classes interesting-classes smallest-class ; : method-for-class ( class generic -- method/f ) - [ nip ] [ nearest-class ] 2bi dup [ swap method ] [ 2drop f ] if ; + [ nip ] [ nearest-class ] 2bi dup [ swap ?lookup-method ] [ 2drop f ] if ; GENERIC: effective-method ( generic -- method ) @@ -66,7 +71,7 @@ GENERIC: effective-method ( generic -- method ) method-classes [ class< ] with filter smallest-class ; : next-method ( class generic -- method/f ) - [ next-method-class ] keep method ; + [ next-method-class ] keep ?lookup-method ; GENERIC: next-method-quot* ( class generic combination -- quot ) @@ -131,7 +136,7 @@ M: method crossref? 2bi ; : create-method ( class generic -- method ) - 2dup method dup [ 2nip dup reset-generic ] [ + 2dup ?lookup-method dup [ 2nip dup reset-generic ] [ drop [ dup ] 2keep reveal-method @@ -158,7 +163,7 @@ M: method forget* [ [ "method-class" word-prop ] [ "method-generic" word-prop ] bi - 2dup method + 2dup ?lookup-method ] keep eq? [ [ [ delete-at ] with-methods ] @@ -195,4 +200,4 @@ M: generic subwords ] { } make ; M: class forget-methods - [ implementors ] [ [ swap method ] curry ] bi map forget-all ; + [ implementors ] [ [ swap ?lookup-method ] curry ] bi map forget-all ; diff --git a/core/generic/hook/hook.factor b/core/generic/hook/hook.factor index 5359f473ac..17fd857b56 100644 --- a/core/generic/hook/hook.factor +++ b/core/generic/hook/hook.factor @@ -3,6 +3,7 @@ USING: accessors definitions generic generic.single generic.single.private kernel namespaces words kernel.private quotations sequences ; +QUALIFIED-WITH: generic.single.private gsp IN: generic.hook TUPLE: hook-combination < single-combination var ; @@ -18,9 +19,9 @@ M: hook-combination picker M: hook-combination dispatch# drop 0 ; M: hook-combination mega-cache-quot - 1quotation picker [ lookup-method (execute) ] surround ; + 1quotation picker [ gsp:lookup-method (execute) ] surround ; M: hook-generic definer drop \ HOOK: f ; M: hook-generic effective-method - [ "combination" word-prop var>> get ] keep method-for-object ; \ No newline at end of file + [ "combination" word-prop var>> get ] keep method-for-object ; diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor index 277f40c34f..8cdb645880 100644 --- a/core/generic/math/math.factor +++ b/core/generic/math/math.factor @@ -51,7 +51,7 @@ ERROR: no-math-method left right generic ; suffix! ] define-core-syntax - "M\\" [ scan-word scan-word method suffix! ] define-core-syntax + "M\\" [ scan-word scan-word lookup-method suffix! ] define-core-syntax "inline" [ word make-inline ] define-core-syntax "recursive" [ word make-recursive ] define-core-syntax "foldable" [ word make-foldable ] define-core-syntax -- 2.34.1