classes.tuple: use slots>tuple when possible.

diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor
index 22feb3382a714fd546e9ff98e396181f4705e364..520602879e2f0358396e6f5fd36472ea8dd1a11a 100644 (file)
--- a/basis/compiler/tree/propagation/slots/slots.factor
+++ b/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 )

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index c1e25d48549c61364101570f3c0cd1df8734e98b..b36364a4d6f4d35a2f7d0e837341eee4e2515a69 100755 (executable)
--- a/core/bootstrap/primitives.factor
+++ b/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

diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor
index 8f523635e0db0e7d41684ce28c56b8d4158adfab..202214770b7cdfeff4c00380fddd589fac0b1ea3 100644 (file)
--- a/core/classes/tuple/parser/parser.factor
+++ b/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 ;

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index ebd3e407cdac815d4bee26264ab777bd1d6739b1..ad2f9fea70c6eb4eddb41b149ed4406012b95bbc 100644 (file)
--- a/core/classes/tuple/tuple.factor
+++ b/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 ;