From af40535556fbffc528c7ae6b075303c75f47b0a3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 24 Jan 2005 02:31:32 +0000
Subject: [PATCH] more descriptive undefined-method error

---
 library/errors.factor             |  5 +++++
 library/generic/generic.factor    | 17 +++++++++--------
 library/inference/words.factor    |  1 +
 library/syntax/prettyprint.factor |  6 +++++-
 library/tools/debugger.factor     | 10 ++++++++++
 5 files changed, 30 insertions(+), 9 deletions(-)

diff --git a/library/errors.factor b/library/errors.factor
index ad0109c116..00def19460 100644
--- 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 abfe9ee63e..24cac9d733 100644
--- 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 6af8a9336f..21b1f3f50f 100644
--- 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 15fefa4794..f067f7d7ed 100644
--- 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 3c3931c0aa..2218c6d12b 100644
--- 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