steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix descriptive with intersection classes

db4
Slava Pestov 2008-05-11 00:36:38 -05:00
parent 640f9643ef
commit 8a4ef17039
2 changed files with 9 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/descriptive/descriptive-tests.factor
View File

@ -4,13 +4,13 @@ IN: descriptive.tests
DESCRIPTIVE: divide ( num denom -- fraction ) / ; DESCRIPTIVE: divide ( num denom -- fraction ) / ;
[ 3 ] [ 9 3 divide ] unit-test [ 3 ] [ 9 3 divide ] unit-test
[ T{ descriptive f { { "num" 3 } { "denom" 0 } } "Division by zero" divide } ] [ [ 3 0 divide ] [ ] recover ] unit-test [ T{ descriptive-error f { { "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 [ "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 / ; DESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;
[ 3 ] [ 9 3 divide* ] unit-test [ 3 ] [ 9 3 divide* ] unit-test
[ T{ descriptive f { { "num" 3 } { "denom" 0 } } "Division by zero" divide* } ] [ [ 3 0 divide* ] [ ] recover ] unit-test [ T{ descriptive-error f { { "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 [ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;\n" ] [ \ divide* [ see ] with-string-writer ] unit-test

15
extra/descriptive/descriptive.factor
View File

@ -3,16 +3,16 @@ locals.private accessors parser namespaces continuations
inspector definitions arrays.lib arrays ; inspector definitions arrays.lib arrays ;
IN: descriptive IN: descriptive
ERROR: descriptive args underlying word ; ERROR: descriptive-error args underlying word ;
M: descriptive summary M: descriptive-error summary
word>> "The " swap word-name " word encountered an error." word>> "The " swap word-name " word encountered an error."
3append ; 3append ;
<PRIVATE <PRIVATE
: rethrower ( word inputs -- quot ) : rethrower ( word inputs -- quot )
[ length ] keep [ >r narray r> swap 2array flip ] 2curry [ length ] keep [ >r narray r> swap 2array flip ] 2curry
[ 2 ndip descriptive ] 2curry ; [ 2 ndip descriptive-error ] 2curry ;
: [descriptive] ( word def -- newdef ) : [descriptive] ( word def -- newdef )
swap dup "declared-effect" word-prop in>> rethrower swap dup "declared-effect" word-prop in>> rethrower
@ -26,19 +26,18 @@ PRIVATE>
: DESCRIPTIVE: : DESCRIPTIVE:
(:) define-descriptive ; parsing (:) define-descriptive ; parsing
PREDICATE: descriptive-def < word PREDICATE: descriptive < word
"descriptive-definition" word-prop ; "descriptive-definition" word-prop ;
M: descriptive-def definer drop \ DESCRIPTIVE: \ ; ; M: descriptive definer drop \ DESCRIPTIVE: \ ; ;
M: descriptive-def definition M: descriptive definition
"descriptive-definition" word-prop ; "descriptive-definition" word-prop ;
: DESCRIPTIVE:: : DESCRIPTIVE::
(::) define-descriptive ; parsing (::) define-descriptive ; parsing
PREDICATE: descriptive-lambda < lambda-word INTERSECTION: descriptive-lambda descriptive lambda-word ;
"descriptive-definition" word-prop ;
M: descriptive-lambda definer drop \ DESCRIPTIVE:: \ ; ; M: descriptive-lambda definer drop \ DESCRIPTIVE:: \ ; ;