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

fix stack effect of ERROR: words that inherit slots from a base class

db4
Joe Groff 2009-09-29 12:52:13 -05:00
parent 302b0a3a10
commit 92e864b019
2 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
core/classes/tuple/tuple-tests.factor
View File

@ -729,3 +729,8 @@ DEFER: redefine-tuple-twice
[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test [ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
[ t ] [ \ redefine-tuple-twice symbol? ] unit-test [ t ] [ \ redefine-tuple-twice symbol? ] unit-test
ERROR: base-error x y ;
ERROR: derived-error < base-error z ;
[ (( x y z -- * )) ] [ \ derived-error stack-effect ] unit-test

8
core/classes/tuple/tuple.factor
View File

@ -280,16 +280,16 @@ M: tuple-class (define-tuple-class)
[ 2drop ?define-symbol ] [ redefine-tuple-class ] if ; [ 2drop ?define-symbol ] [ redefine-tuple-class ] if ;
: thrower-effect ( slots -- effect ) : thrower-effect ( slots -- effect )
[ dup array? [ first ] when ] map { "*" } <effect> ; [ name>> ] map { "*" } <effect> ;
: define-error-class ( class superclass slots -- ) : define-error-class ( class superclass slots -- )
[ define-tuple-class ] [ define-tuple-class ]
[ 2drop reset-generic ] [ 2drop reset-generic ]
[ [
2drop
[ dup [ boa throw ] curry ] [ dup [ boa throw ] curry ]
[ drop ] [ all-slots thrower-effect ]
[ thrower-effect ] bi define-declared
tri* define-declared
] 3tri ; ] 3tri ;
: boa-effect ( class -- effect ) : boa-effect ( class -- effect )