tuple-arrays: further performance improvements

diff --git a/basis/tuple-arrays/tuple-arrays-tests.factor b/basis/tuple-arrays/tuple-arrays-tests.factor
index 4606ecdadaa330178a341f96f7211372def90c0d..2eeae20aa1d2b0cf1b57c7cea7350a52acc4efb7 100644 (file)
--- a/basis/tuple-arrays/tuple-arrays-tests.factor
+++ b/basis/tuple-arrays/tuple-arrays-tests.factor
@@ -23,3 +23,10 @@ TUPLE-ARRAY: baz
 
 [ 0 ] [ 1 <baz-array> first bing>> ] unit-test
 [ f ] [ 1 <baz-array> first bong>> ] unit-test
+
+TUPLE: broken x ;
+: broken ( -- ) ;
+
+TUPLE-ARRAY: broken
+
+[ 100 ] [ 100 <broken-array> length ] unit-test
\ No newline at end of file

diff --git a/basis/tuple-arrays/tuple-arrays.factor b/basis/tuple-arrays/tuple-arrays.factor
index 466262f3e080acf74c3076e57d2c40bb3a1fca22..35d771416c468473b3301d9497b0e07c455ff8f6 100644 (file)
--- a/basis/tuple-arrays/tuple-arrays.factor
+++ b/basis/tuple-arrays/tuple-arrays.factor
@@ -1,26 +1,36 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators.smart fry functors grouping
-kernel macros sequences sequences.private stack-checker
-parser ;
+USING: accessors arrays combinators.smart fry functors kernel
+kernel.private macros sequences combinators sequences.private
+stack-checker parser math classes.tuple.private ;
 FROM: inverse => undo ;
 IN: tuple-arrays
 
 <PRIVATE
 
+MACRO: boa-unsafe ( class -- quot ) tuple-layout '[ _ <tuple-boa> ] ;
+
 MACRO: infer-in ( class -- quot ) infer in>> '[ _ ] ;
 
+: tuple-arity ( class -- quot ) '[ _ boa ] infer-in ; inline
+
 : smart-tuple>array ( tuple class -- array )
     '[ [ _ boa ] undo ] output>array ; inline
 
-: smart-array>tuple ( array class -- tuple )
-    '[ _ boa ] input<sequence ; inline
-
-: tuple-arity ( class -- quot ) '[ _ boa ] infer-in ; inline
-
 : tuple-prototype ( class -- array )
     [ new ] [ smart-tuple>array ] bi ; inline
 
+: tuple-slice ( n seq -- slice )
+    [ n>> [ * dup ] keep + ] [ seq>> ] bi { array } declare slice boa ; inline
+
+: read-tuple ( slice class -- tuple )
+    '[ _ boa-unsafe ] input<sequence-unsafe ; inline
+
+MACRO: write-tuple ( class -- quot )
+    [ '[ [ _ boa ] undo ] ]
+    [ tuple-arity <reversed> [ '[ [ _ ] dip set-nth-unsafe ] ] map '[ _ cleave ] ]
+    bi '[ _ dip @ ] ;
+
 PRIVATE>
 
 FUNCTOR: define-tuple-array ( CLASS -- )
@@ -35,31 +45,26 @@ CLASS-array? IS ${CLASS-array}?
 
 WHERE
 
-TUPLE: CLASS-array { seq sliced-groups read-only } ;
+TUPLE: CLASS-array
+{ seq array read-only }
+{ n array-capacity read-only }
+{ length array-capacity read-only } ;
 
 : <CLASS-array> ( length -- tuple-array )
-    CLASS tuple-prototype <repetition> concat
-    CLASS tuple-arity <sliced-groups>
-    CLASS-array boa ;
+    [ \ CLASS [ tuple-prototype <repetition> concat ] [ tuple-arity ] bi ] keep
+    \ CLASS-array boa ; inline
 
-M: CLASS-array nth-unsafe
-    seq>> nth-unsafe CLASS smart-array>tuple ;
+M: CLASS-array length length>> ;
 
-M: CLASS-array set-nth-unsafe
-    [ CLASS smart-tuple>array ] 2dip seq>> set-nth-unsafe ;
+M: CLASS-array nth-unsafe tuple-slice \ CLASS read-tuple ;
 
-M: CLASS-array new-sequence
-    drop <CLASS-array> ;
+M: CLASS-array set-nth-unsafe tuple-slice \ CLASS write-tuple ;
 
-: >CLASS-array ( seq -- tuple-array )
-    dup empty? [
-        0 <CLASS-array> clone-like
-    ] unless ;
+M: CLASS-array new-sequence drop <CLASS-array> ;
 
-M: CLASS-array like 
-    drop dup CLASS-array? [ >CLASS-array ] unless ;
+: >CLASS-array ( seq -- tuple-array ) 0 <CLASS-array> clone-like ;
 
-M: CLASS-array length seq>> length ;
+M: CLASS-array like drop dup CLASS-array? [ >CLASS-array ] unless ;
 
 INSTANCE: CLASS-array sequence