classes.tuple: use slots>tuple when possible.

basis/compiler/tree/propagation/slots/slots.factor

@@ -26,7 +26,7 @@ IN: compiler.tree.propagation.slots
     <sequence-info> 1array ;
 
 : fold-<tuple-boa> ( values class -- info )
-    [ [ literal>> ] map ] dip prefix >tuple
+    [ [ literal>> ] map ] dip slots>tuple
     <literal-info> ;
 
 : read-only-slots ( values class -- slots )

core/bootstrap/primitives.factor

@@ -260,12 +260,12 @@ tuple
 { "state" } define-tuple-class
 
 "((empty))" "hashtables.private" create
-"tombstone" "hashtables.private" lookup-word f
-2array >tuple 1quotation ( -- value ) define-inline
+{ f } "tombstone" "hashtables.private" lookup-word
+slots>tuple 1quotation ( -- value ) define-inline
 
 "((tombstone))" "hashtables.private" create
-"tombstone" "hashtables.private" lookup-word t
-2array >tuple 1quotation ( -- value ) define-inline
+{ t } "tombstone" "hashtables.private" lookup-word
+slots>tuple 1quotation ( -- value ) define-inline
 
 ! Some tuple classes
 "curry" "kernel" create

core/classes/tuple/parser/parser.factor

@@ -94,7 +94,7 @@ ERROR: bad-slot-name class slot ;
 GENERIC# boa>object 1 ( class slots -- tuple )
 
 M: tuple-class boa>object
-    swap prefix >tuple ;
+    swap slots>tuple ;
 
 : check-slot-exists ( class initials slot-spec/f index/f name -- class initials slot-spec index )
     over [ drop ] [ nip nip nip bad-slot-name ] if ;

core/classes/tuple/tuple.factor

@@ -56,8 +56,8 @@ M: tuple class-of layout-of 2 slot { word } declare ; inline
 : check-tuple ( object -- tuple )
     dup tuple? [ not-a-tuple ] unless ; inline
 
-: prepare-tuple>array ( tuple -- n tuple layout )
-    check-tuple [ tuple-size iota ] [ ] [ layout-of ] tri ;
+: prepare-tuple-slots ( tuple -- n tuple )
+    check-tuple [ tuple-size iota ] keep ;
 
 : copy-tuple-slots ( n tuple -- array )
     [ array-nth ] curry map ;
@@ -78,13 +78,8 @@ M: tuple class-of layout-of 2 slot { word } declare ; inline
 
 PRIVATE>
 
-: tuple>array ( tuple -- array )
-    prepare-tuple>array
-    [ copy-tuple-slots ] dip
-    first prefix ;
-
 : tuple-slots ( tuple -- seq )
-    prepare-tuple>array drop copy-tuple-slots ;
+    prepare-tuple-slots copy-tuple-slots ;
 
 GENERIC: slots>tuple ( seq class -- tuple )
 
@@ -96,6 +91,9 @@ M: tuple-class slots>tuple ( seq class -- tuple )
         bi 2each
     ] keep ;
 
+: tuple>array ( tuple -- array )
+    [ tuple-slots ] [ layout-of first prefix ] bi ;
+
 : >tuple ( seq -- tuple )
     unclip slots>tuple ;