diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor index 22feb3382a..520602879e 100644 --- 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 1array ; : fold- ( values class -- info ) - [ [ literal>> ] map ] dip prefix >tuple + [ [ literal>> ] map ] dip slots>tuple ; : read-only-slots ( values class -- slots ) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index c1e25d4854..b36364a4d6 100755 --- 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 8f523635e0..202214770b 100644 --- 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 ebd3e407cd..ad2f9fea70 100644 --- 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 ;