more descriptive undefined-method error

diff --git a/library/errors.factor b/library/errors.factor
index ad0109c116fd6bb02614dd6d67635376275368a5..00def194602b8fa57bb007d512bffa57a1ea82a8 100644 (file)
--- a/library/errors.factor
+++ b/library/errors.factor
@@ -37,6 +37,11 @@ USE: namespaces
 USE: strings
 USE: vectors
 
+: undefined-method ( object generic -- )
+    #! This word is redefined in tools/debugger.factor with a
+    #! more useful definition once unparse is available.
+    "No suitable method" throw ;
+
 ! This is a very lightweight exception handling system.
 
 : catchstack ( -- cs ) 6 getenv ;

diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index abfe9ee63e1dce9ee7d363e8076a8812f2b15d24..24cac9d7334fc481e25082bb2b1f09eb1011e230 100644 (file)
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -38,6 +38,7 @@ USE: words
 USE: vectors
 USE: math
 USE: math-internals
+USE: unparser
 
 ! A simple single-dispatch generic word system.
 
@@ -64,9 +65,6 @@ USE: math-internals
 ! Metaclasses have priority -- this induces an order in which
 ! methods are added to the vtable.
 
-: undefined-method
-    "No applicable method." throw ;
-
 : metaclass ( class -- metaclass )
     "metaclass" word-property ;
 
@@ -94,14 +92,17 @@ USE: math-internals
     #! Add the method entry to the vtable. Unlike define-method,
     #! this is called at vtable build time, and in the sorted
     #! order.
-    dup metaclass "add-method" word-property
-    [ [ undefined-method ] ] unless* call ;
+    dup metaclass "add-method" word-property [
+        [ "Metaclass is missing add-method" throw ]
+    ] unless* call ;
 
-: <empty-vtable> ( -- vtable )
-    num-types [ drop [ undefined-method ] ] vector-project ;
+: <empty-vtable> ( generic -- vtable )
+    unit num-types
+    [ drop dup [ car undefined-method ] cons ] vector-project
+    nip ;
 
 : <vtable> ( generic -- vtable )
-    <empty-vtable> over methods [
+    dup <empty-vtable> over methods [
         ( generic vtable method )
         >r 2dup r> unswons add-method
     ] each nip ;

diff --git a/library/inference/words.factor b/library/inference/words.factor
index 6af8a9336fb5709d08855a100bae0adac9cfaeb8..21b1f3f50f209fd7c4eabfc77d20e6d47d136449 100644 (file)
--- a/library/inference/words.factor
+++ b/library/inference/words.factor
@@ -204,5 +204,6 @@ M: symbol (apply-word) ( word -- )
 \ - [ [ number number ] [ number ] ] "infer-effect" set-word-property
 
 \ undefined-method t "terminator" set-word-property
+\ undefined-method [ [ object word ] [ ] ] "infer-effect" set-word-property
 \ not-a-number t "terminator" set-word-property
 \ throw t "terminator" set-word-property

diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor
index 15fefa4794ee3984c7a8faee07fba5906b6a9ba7..f067f7d7ed8288dd28bf4fdce4d43e6ba730e9da 100644 (file)
--- a/library/syntax/prettyprint.factor
+++ b/library/syntax/prettyprint.factor
@@ -121,7 +121,11 @@ M: word prettyprint* ( indent word -- indent )
     [ prettyprint-element ] each ;
 
 M: list prettyprint* ( indent list -- indent )
-    swap prettyprint-[ swap prettyprint-list prettyprint-] ;
+    [
+        swap prettyprint-[ swap prettyprint-list prettyprint-]
+    ] [
+        f unparse write
+    ] ifte* ;
 
 M: cons prettyprint* ( indent cons -- indent )
     \ [[ prettyprint* " " write

diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor
index 3c3931c0aabd3c331090095b93f225b0fd3a12fd..2218c6d12b150d9fe2a9710969eb6aea9eb3a112 100644 (file)
--- a/library/tools/debugger.factor
+++ b/library/tools/debugger.factor
@@ -175,6 +175,16 @@ M: object error. ( error -- )
     [ dup save-error rethrow ] 5 setenv ( kernel calls on error )
     kernel-error 12 setenv ;
 
+: undefined-method ( object generic -- )
+    #! We 2dup here to leave both values on the stack, for
+    #! post-mortem inspection.
+    2dup [
+        "The generic word " ,
+        unparse ,
+        " does not have a suitable method for " ,
+        unparse ,
+    ] make-string throw ;
+
 ! So that stage 2 boot gives a useful error message if something
 ! fails after this file is loaded.
 init-error-handler