more descriptive undefined-method error
parent
c026fd7786
commit
af40535556
|
@ -37,6 +37,11 @@ USE: namespaces
|
||||||
USE: strings
|
USE: strings
|
||||||
USE: vectors
|
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.
|
! This is a very lightweight exception handling system.
|
||||||
|
|
||||||
: catchstack ( -- cs ) 6 getenv ;
|
: catchstack ( -- cs ) 6 getenv ;
|
||||||
|
|
|
@ -38,6 +38,7 @@ USE: words
|
||||||
USE: vectors
|
USE: vectors
|
||||||
USE: math
|
USE: math
|
||||||
USE: math-internals
|
USE: math-internals
|
||||||
|
USE: unparser
|
||||||
|
|
||||||
! A simple single-dispatch generic word system.
|
! A simple single-dispatch generic word system.
|
||||||
|
|
||||||
|
@ -64,9 +65,6 @@ USE: math-internals
|
||||||
! Metaclasses have priority -- this induces an order in which
|
! Metaclasses have priority -- this induces an order in which
|
||||||
! methods are added to the vtable.
|
! methods are added to the vtable.
|
||||||
|
|
||||||
: undefined-method
|
|
||||||
"No applicable method." throw ;
|
|
||||||
|
|
||||||
: metaclass ( class -- metaclass )
|
: metaclass ( class -- metaclass )
|
||||||
"metaclass" word-property ;
|
"metaclass" word-property ;
|
||||||
|
|
||||||
|
@ -94,14 +92,17 @@ USE: math-internals
|
||||||
#! Add the method entry to the vtable. Unlike define-method,
|
#! Add the method entry to the vtable. Unlike define-method,
|
||||||
#! this is called at vtable build time, and in the sorted
|
#! this is called at vtable build time, and in the sorted
|
||||||
#! order.
|
#! order.
|
||||||
dup metaclass "add-method" word-property
|
dup metaclass "add-method" word-property [
|
||||||
[ [ undefined-method ] ] unless* call ;
|
[ "Metaclass is missing add-method" throw ]
|
||||||
|
] unless* call ;
|
||||||
|
|
||||||
: <empty-vtable> ( -- vtable )
|
: <empty-vtable> ( generic -- vtable )
|
||||||
num-types [ drop [ undefined-method ] ] vector-project ;
|
unit num-types
|
||||||
|
[ drop dup [ car undefined-method ] cons ] vector-project
|
||||||
|
nip ;
|
||||||
|
|
||||||
: <vtable> ( generic -- vtable )
|
: <vtable> ( generic -- vtable )
|
||||||
<empty-vtable> over methods [
|
dup <empty-vtable> over methods [
|
||||||
( generic vtable method )
|
( generic vtable method )
|
||||||
>r 2dup r> unswons add-method
|
>r 2dup r> unswons add-method
|
||||||
] each nip ;
|
] each nip ;
|
||||||
|
|
|
@ -204,5 +204,6 @@ M: symbol (apply-word) ( word -- )
|
||||||
\ - [ [ number number ] [ number ] ] "infer-effect" set-word-property
|
\ - [ [ number number ] [ number ] ] "infer-effect" set-word-property
|
||||||
|
|
||||||
\ undefined-method t "terminator" 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
|
\ not-a-number t "terminator" set-word-property
|
||||||
\ throw t "terminator" set-word-property
|
\ throw t "terminator" set-word-property
|
||||||
|
|
|
@ -121,7 +121,11 @@ M: word prettyprint* ( indent word -- indent )
|
||||||
[ prettyprint-element ] each ;
|
[ prettyprint-element ] each ;
|
||||||
|
|
||||||
M: list prettyprint* ( indent list -- indent )
|
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 )
|
M: cons prettyprint* ( indent cons -- indent )
|
||||||
\ [[ prettyprint* " " write
|
\ [[ prettyprint* " " write
|
||||||
|
|
|
@ -175,6 +175,16 @@ M: object error. ( error -- )
|
||||||
[ dup save-error rethrow ] 5 setenv ( kernel calls on error )
|
[ dup save-error rethrow ] 5 setenv ( kernel calls on error )
|
||||||
kernel-error 12 setenv ;
|
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
|
! So that stage 2 boot gives a useful error message if something
|
||||||
! fails after this file is loaded.
|
! fails after this file is loaded.
|
||||||
init-error-handler
|
init-error-handler
|
||||||
|
|
Loading…
Reference in New Issue