classes.tuple: a better error if creating a tuple from too many values.
parent
b0ea2a0036
commit
9dcca84c27
|
@ -860,3 +860,6 @@ C: <no-slot-tuple0> no-slot-tuple0
|
|||
[ name>> "d" = ]
|
||||
} 1&&
|
||||
] must-fail-with
|
||||
|
||||
[ "IN: classes.tuple.tests TUPLE: too-many-slots-test a b c d ; T{ too-many-slots-test f 1 2 3 4 5 }" eval( -- x ) ]
|
||||
[ error>> too-many-slots? ] must-fail-with
|
||||
|
|
|
@ -15,6 +15,8 @@ PRIVATE>
|
|||
PREDICATE: tuple-class < class
|
||||
"metaclass" word-prop tuple-class eq? ;
|
||||
|
||||
ERROR: too-many-slots class slots got max ;
|
||||
|
||||
ERROR: not-a-tuple object ;
|
||||
|
||||
: all-slots ( class -- slots )
|
||||
|
@ -75,11 +77,16 @@ M: tuple class-of layout-of 2 slot { word } declare ; inline
|
|||
] 2each
|
||||
] if-bootstrapping ; inline
|
||||
|
||||
: initial-values ( class -- slots )
|
||||
all-slots [ initial>> ] map ;
|
||||
: initial-values ( class -- seq )
|
||||
all-slots [ initial>> ] map ; inline
|
||||
|
||||
: pad-slots ( slots class -- slots' class )
|
||||
[ initial-values over length tail append ] keep ; inline
|
||||
: pad-slots ( seq class -- seq' class )
|
||||
[ initial-values ] keep
|
||||
2over [ length ] bi@ 2dup > [
|
||||
[ nip swap ] 2dip too-many-slots
|
||||
] [
|
||||
drop [ tail append ] curry dip
|
||||
] if ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
Loading…
Reference in New Issue