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

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 6d5b8750a9f243af25f1b3deb33ec13798bb931c..ea1deadf9487fe815ff824fb0fd214e075548d2a 100644 (file)
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -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

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 37e93e0056151a287547bf738c7cf4f74c36434a..7ad2d456e4e5bc684eaeb006ed9474fa14c8951f 100644 (file)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -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>