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

classes.tuple: a better error if creating a tuple from too many values.

db4
John Benediktsson 2015-08-15 19:39:39 -07:00
parent b0ea2a0036
commit 9dcca84c27
2 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -860,3 +860,6 @@ C: <no-slot-tuple0> no-slot-tuple0
[ name>> "d" = ] [ name>> "d" = ]
} 1&& } 1&&
] must-fail-with ] 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
core/classes/tuple/tuple.factor
View File

@ -15,6 +15,8 @@ PRIVATE>
PREDICATE: tuple-class < class PREDICATE: tuple-class < class
"metaclass" word-prop tuple-class eq? ; "metaclass" word-prop tuple-class eq? ;
ERROR: too-many-slots class slots got max ;
ERROR: not-a-tuple object ; ERROR: not-a-tuple object ;
: all-slots ( class -- slots ) : all-slots ( class -- slots )
@ -75,11 +77,16 @@ M: tuple class-of layout-of 2 slot { word } declare ; inline
] 2each ] 2each
] if-bootstrapping ; inline ] if-bootstrapping ; inline
: initial-values ( class -- slots ) : initial-values ( class -- seq )
all-slots [ initial>> ] map ; all-slots [ initial>> ] map ; inline
: pad-slots ( slots class -- slots' class ) : pad-slots ( seq class -- seq' class )
[ initial-values over length tail append ] keep ; inline [ initial-values ] keep
2over [ length ] bi@ 2dup > [
[ nip swap ] 2dip too-many-slots
] [
drop [ tail append ] curry dip
] if ; inline
PRIVATE> PRIVATE>