Descriptive errors, deleting duplicated code in locals

db4
Daniel Ehrenberg 2008-05-10 16:05:20 -05:00
parent 46b4167a24
commit 747a4766ef
3 changed files with 61 additions and 10 deletions

View File

@ -0,0 +1,16 @@
USING: descriptive kernel math tools.test continuations prettyprint io.streams.string ;
IN: descriptive.tests
DESCRIPTIVE: divide ( num denom -- fraction ) / ;
[ 3 ] [ 9 3 divide ] unit-test
[ T{ known f H{ { "num" 3 } { "denom" 0 } } "Division by zero" divide } ] [ [ 3 0 divide ] [ ] recover ] unit-test
[ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE: divide ( num denom -- fraction ) / ;\n" ] [ \ divide [ see ] with-string-writer ] unit-test
DESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;
[ 3 ] [ 9 3 divide* ] unit-test
[ T{ known f H{ { "num" 3 } { "denom" 0 } } "Division by zero" divide* } ] [ [ 3 0 divide* ] [ ] recover ] unit-test
[ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;\n" ] [ \ divide* [ see ] with-string-writer ] unit-test

View File

@ -0,0 +1,45 @@
USING: words kernel sequences combinators.lib locals
locals.private accessors parser namespaces continuations
inspector definitions ;
IN: descriptive
ERROR: known args underlying word ;
M: known summary
word>> "The " swap word-name " word encountered an error."
3append ;
: rethrower ( word inputs -- quot )
reverse [ [ set ] curry ] map concat [ ] like
[ H{ } make-assoc ] curry
[ 2 ndip known ] 2curry ;
: [descriptive] ( word def -- newdef )
swap dup "declared-effect" word-prop in>> rethrower
[ recover ] 2curry ;
: define-descriptive ( word def -- )
[ "descriptive-definition" set-word-prop ]
[ dupd [descriptive] define ] 2bi ;
: DESCRIPTIVE:
(:) define-descriptive ; parsing
PREDICATE: descriptive-word < word
"descriptive-definition" word-prop ;
M: descriptive-word definer drop \ DESCRIPTIVE: \ ; ;
M: descriptive-word definition
"descriptive-definition" word-prop ;
: DESCRIPTIVE::
(::) define-descriptive ; parsing
PREDICATE: descriptive-lambda < lambda-word
"descriptive-definition" word-prop ;
M: descriptive-lambda definer drop \ DESCRIPTIVE:: \ ; ;
M: descriptive-lambda definition
"lambda" word-prop body>> ;

View File

@ -363,14 +363,6 @@ M: lambda-word definer drop \ :: \ ; ;
M: lambda-word definition
"lambda" word-prop body>> ;
: lambda-word-synopsis ( word -- )
dup definer.
dup seeing-word
dup pprint-word
stack-effect. ;
M: lambda-word synopsis* lambda-word-synopsis ;
PREDICATE: lambda-macro < macro
"lambda" word-prop >boolean ;
@ -379,8 +371,6 @@ M: lambda-macro definer drop \ MACRO:: \ ; ;
M: lambda-macro definition
"lambda" word-prop body>> ;
M: lambda-macro synopsis* lambda-word-synopsis ;
PREDICATE: lambda-method < method-body
"lambda" word-prop >boolean ;