Throw typed errors instead of strings for calling/executing non-callables

Doug Coleman 2009-08-11 22:40:29 -05:00
parent 6a62b2b09a
commit 4c570faa91
2 changed files with 12 additions and 6 deletions

View File

@ -5,7 +5,7 @@ parser sequences strings vectors words quotations effects classes
continuations assocs combinators compiler.errors accessors math.order
definitions sets hints macros stack-checker.state
stack-checker.visitor stack-checker.errors stack-checker.values
stack-checker.recursive-state ;
stack-checker.recursive-state summary ;
IN: stack-checker.backend
: push-d ( obj -- ) meta-d push ;
@ -98,8 +98,10 @@ M: object apply-object push-literal ;
: time-bomb ( error -- )
'[ _ throw ] infer-quot-here ;
: bad-call ( -- )
"call must be given a callable" time-bomb ;
ERROR: bad-call obj ;
M: bad-call summary
drop "call must be given a callable" ;
: infer-literal-quot ( literal -- )
dup recursive-quotation? [
@ -110,7 +112,7 @@ M: object apply-object push-literal ;
[ [ recursion>> ] keep add-local-quotation ]
bi infer-quot
] [
drop bad-call
value>> \ bad-call boa time-bomb
] if
] if ;

View File

@ -134,13 +134,17 @@ M: object infer-call*
\ compose [ infer-compose ] "special" set-word-prop
ERROR: bad-executable obj ;
M: bad-executable summary
drop "execute must be given a word" ;
: infer-execute ( -- )
pop-literal nip
dup word? [
apply-object
] [
drop
"execute must be given a word" time-bomb
\ bad-executable boa time-bomb
] if ;
\ execute [ infer-execute ] "special" set-word-prop