steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

tuple-arrays: further performance improvements

db4
Slava Pestov 2009-04-26 21:24:55 -05:00
parent 58cba832a0
commit 84f672e74b
2 changed files with 37 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/tuple-arrays/tuple-arrays-tests.factor
View File

@ -23,3 +23,10 @@ TUPLE-ARRAY: baz
[ 0 ] [ 1 <baz-array> first bing>> ] unit-test [ 0 ] [ 1 <baz-array> first bing>> ] unit-test
[ f ] [ 1 <baz-array> first bong>> ] unit-test [ f ] [ 1 <baz-array> first bong>> ] unit-test
TUPLE: broken x ;
: broken ( -- ) ;
TUPLE-ARRAY: broken
[ 100 ] [ 100 <broken-array> length ] unit-test

55
basis/tuple-arrays/tuple-arrays.factor
View File

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