Improved ERROR:

db4
Slava Pestov 2008-07-03 02:47:29 -05:00
parent cb121c5b50
commit 72d9c040b4
3 changed files with 33 additions and 3 deletions

View File

@ -656,3 +656,28 @@ T{ reshape-test f "hi" } "tuple" set
TUPLE: boa-coercer-test { x array-capacity } ;
[ fixnum ] [ 0 >bignum boa-coercer-test boa x>> class ] unit-test
! Test error classes
ERROR: error-class-test a b c ;
[ "( a b c -- * )" ] [ \ error-class-test stack-effect effect>string ] unit-test
[ f ] [ \ error-class-test "inline" word-prop ] unit-test
[ "IN: classes.tuple.tests ERROR: error-x ; : error-x 3 ;" eval ]
[ error>> error>> redefine-error? ] must-fail-with
DEFER: error-y
[ ] [ [ \ error-y forget-class ] with-compilation-unit ] unit-test
[ ] [ "IN: classes.tuple.tests GENERIC: error-y" eval ] unit-test
[ f ] [ \ error-y tuple-class? ] unit-test
[ t ] [ \ error-y generic? ] unit-test
[ ] [ "IN: classes.tuple.tests ERROR: error-y ;" eval ] unit-test
[ t ] [ \ error-y tuple-class? ] unit-test
[ f ] [ \ error-y generic? ] unit-test

View File

@ -4,7 +4,7 @@ USING: arrays definitions hashtables kernel kernel.private math
namespaces sequences sequences.private strings vectors words
quotations memory combinators generic classes classes.algebra
classes.private slots.deprecated slots.private slots
compiler.units math.private accessors assocs ;
compiler.units math.private accessors assocs effects ;
IN: classes.tuple
M: tuple class 1 slot 2 slot { word } declare ;
@ -255,9 +255,13 @@ M: tuple-class define-tuple-class
3dup tuple-class-unchanged?
[ 3drop ] [ redefine-tuple-class ] if ;
: thrower-effect ( slots -- effect )
[ dup array? [ first ] when ] map f <effect> t >>terminated? ;
: define-error-class ( class superclass slots -- )
[ define-tuple-class ] [ 2drop ] 3bi
dup [ boa throw ] curry define ;
[ define-tuple-class ]
[ [ dup [ boa throw ] curry ] [ drop ] [ thrower-effect ] tri* ] 3bi
define-declared ;
M: tuple-class reset-class
[

View File

@ -175,6 +175,7 @@ IN: bootstrap.syntax
"ERROR:" [
parse-tuple-definition
pick reset-generic
pick save-location
define-error-class
] define-syntax