Make M\ throw an error upon lookup failure. Change method -> ?lookup-method, lookup...

diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index 56d1cec21d93e46e3bfb4f64858f39186439e84c..40fbf026e37408adba8289cda1fdfe9822054039 100644 (file)
--- 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 db26f4d20942464ec8137e110f9a5d52141e3ec2..7a9b05aa67b23cbf5358c18d87f788076b21de80 100644 (file)
--- 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 6bb623cac4513f3442fe959c0d5559f84558480a..c291194019e74cd3b5a244ba80486a157c9c3152 100644 (file)
--- 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 93b1e6fa92258d21bdb4c2a191a14e61c92e958a..b8915c84bbc6f7b301d7ff7f989a5650d8af51a4 100644 (file)
--- 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 7958f51bc30d335c441bf9e2526bd372511396e8..ec005482d186ead3fa85419e2d78d7985ed037af 100644 (file)
--- 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*
 <PRIVATE
 
 : forget-all-methods ( classes words -- )
-    [ first method forget ] cartesian-each ;
+    [ first lookup-method forget ] cartesian-each ;
 
 : protocol-users ( protocol -- users )
     protocol-consult keys ;

diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor
index ec742cb1ce82015de7a62497aff6f814f368f128..5c9b4d8a4b855fe8a9e3b4f07914f5bc1ddafb97 100644 (file)
--- a/basis/math/intervals/intervals.factor
+++ b/basis/math/intervals/intervals.factor
@@ -275,7 +275,7 @@ MEMO: array-capacity-interval ( -- interval )
 : interval/-safe ( i1 i2 -- i3 )
     #! Just a hack to make the compiler work if bootstrap.math
     #! is not loaded.
-    \ integer \ / method [ interval/ ] [ 2drop f ] if ;
+    \ integer \ / ?lookup-method [ interval/ ] [ 2drop f ] if ;
 
 : interval/i ( i1 i2 -- i3 )
     [

diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor
index e72d77ee1f6d89a4ad1103e1f58599deca936ba2..2f928dcbe37b77825143f03331dd29ae4e3cdf38 100644 (file)
--- a/basis/math/partial-dispatch/partial-dispatch.factor
+++ b/basis/math/partial-dispatch/partial-dispatch.factor
@@ -127,7 +127,7 @@ M: word integer-op-input-classes
 
 : define-math-ops ( op -- )
     { fixnum bignum float }
-    [ [ dup 3array ] [ swap method ] 2bi ] with { } map>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 38a8a489349ad557bd603a0a6941c3ea67a14710..839e7a5d0522831a99daf4f38c55653c2e4374d6 100644 (file)
--- 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 0ef3976e6286aa939e055c792001b04a36cf0e64..bc7e28c2b087aa5d12d4e27993e3a13b1673c6c8 100644 (file)
--- 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 c79d8b443c00799363ba63611c31335b7f7e4fef..f002d950324cb1e62bba340ccbb3dba6bf58e7ca 100644 (file)
--- 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 45af82ea83a95cffbdca9115ced998d75115e915..5132f1f027778e236c38e7539fa6db7ce1042167 100644 (file)
--- 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 6360a9662c0fed271bcd1eeb488a07f399de88ad..f542fbe7fdbe3c80e4f6933e88f791b568037884 100644 (file)
--- 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 a733ac90fa3133a16ba24d600ebf722f0e49870a..c360067fa3bb2cdb2e8144a1f68f0c40db8bf46a 100644 (file)
--- 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* ;
+
 <PRIVATE
 
 : interesting-class? ( class1 class2 -- ? )
@@ -56,7 +61,7 @@ PRIVATE>
     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
         [ <method> 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 5359f473ac5e52beb3420320e925521eee1e246e..17fd857b56864c77be1a4b9e9bf5ae0b097eea31 100644 (file)
--- 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 277f40c34fc673a07c8dc4c1e38c6f4c57ffd846..8cdb645880ad3602adc00ccb7a3e3e8daf16d7f4 100644 (file)
--- a/core/generic/math/math.factor
+++ b/core/generic/math/math.factor
@@ -51,7 +51,7 @@ ERROR: no-math-method left right generic ;
 <PRIVATE
 
 : (math-method) ( generic class -- quot )
-    over method
+    over ?lookup-method
     [ 1quotation ]
     [ default-math-method ] ?if ;
 

diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor
index 5599b48fe102a7593328b4dfe9be43897e1b6036..e1908bf09f3a0366226cc7557f10721e276efa33 100644 (file)
--- a/core/generic/single/single.factor
+++ b/core/generic/single/single.factor
@@ -46,8 +46,10 @@ M: single-combination next-method-quot* ( class generic combination -- quot )
     ] with-combination ;
 
 : method-for-object ( obj word -- method )
-    [ [ method-classes [ instance? ] with filter smallest-class ] keep method ]
-    [ "default-method" word-prop ]
+    [
+        [ method-classes [ instance? ] with filter smallest-class ] keep
+        ?lookup-method
+    ] [ "default-method" word-prop ]
     bi or ;
 
 M: single-combination make-default-method

diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor
index d3b2c46cc217f8f03a6e115709728e8c11766977..a5e7b830b2d293360ca0464b694db38d15d72ccc 100644 (file)
--- a/core/generic/standard/standard-tests.factor
+++ b/core/generic/standard/standard-tests.factor
@@ -236,7 +236,7 @@ GENERIC: generic-forget-test ( a -- b )
 
 M: f generic-forget-test ;
 
-[ ] [ \ f \ generic-forget-test method "m" set ] unit-test
+[ ] [ \ f \ generic-forget-test lookup-method "m" set ] unit-test
 
 [ ] [ [ "m" get forget ] with-compilation-unit ] unit-test
 

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index ceef21bc765c4140472c8e7ecc85d4e7e088f372..c99802d44b1dbd662a700f040f91fb6c4ae9b550 100644 (file)
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -108,7 +108,7 @@ IN: bootstrap.syntax
 
     "POSTPONE:" [ scan-word suffix! ] define-core-syntax
     "\\" [ scan-word <wrapper> suffix! ] define-core-syntax
-    "M\\" [ scan-word scan-word method <wrapper> suffix! ] define-core-syntax
+    "M\\" [ scan-word scan-word lookup-method <wrapper> 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