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

More efficient float arrayss; 15% improvement on spectral-norm

db4
Slava Pestov 2008-07-12 21:15:11 -05:00
parent 0770d50d7b
commit a700ec7041
2 changed files with 10 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
core/alien/c-types/c-types.factor
View File

@ -151,7 +151,8 @@ M: byte-array byte-length length ;
swap dup length memcpy ; swap dup length memcpy ;
: (define-nth) ( word type quot -- ) : (define-nth) ( word type quot -- )
>r heap-size [ rot * ] swap prefix r> append define-inline ; >r heap-size [ rot * >fixnum ] swap prefix
r> append define-inline ;
: nth-word ( name vocab -- word ) : nth-word ( name vocab -- word )
>r "-nth" append r> create ; >r "-nth" append r> create ;

24
extra/float-arrays/float-arrays.factor
View File

@ -9,16 +9,8 @@ TUPLE: float-array
{ length array-capacity read-only } { length array-capacity read-only }
{ underlying byte-array read-only } ; { underlying byte-array read-only } ;
<PRIVATE
: floats>bytes 8 * ; inline
: float-array@ underlying>> swap >fixnum floats>bytes ; inline
PRIVATE>
: <float-array> ( n -- float-array ) : <float-array> ( n -- float-array )
dup floats>bytes <byte-array> float-array boa ; inline dup "double" <c-array> float-array boa ; inline
M: float-array clone M: float-array clone
[ length>> ] [ underlying>> clone ] bi float-array boa ; [ length>> ] [ underlying>> clone ] bi float-array boa ;
@ -26,13 +18,13 @@ M: float-array clone
M: float-array length length>> ; M: float-array length length>> ;
M: float-array nth-unsafe M: float-array nth-unsafe
float-array@ alien-double ; underlying>> double-nth ;
M: float-array set-nth-unsafe M: float-array set-nth-unsafe
[ >float ] 2dip float-array@ set-alien-double ; [ >float ] 2dip underlying>> set-double-nth ;
: >float-array ( seq -- float-array ) : >float-array ( seq -- float-array )
T{ float-array f 0 B{ } } clone-like ; inline T{ float-array } clone-like ; inline
M: float-array like M: float-array like
drop dup float-array? [ >float-array ] unless ; drop dup float-array? [ >float-array ] unless ;
@ -45,7 +37,7 @@ M: float-array equal?
M: float-array resize M: float-array resize
[ drop ] [ [ drop ] [
[ floats>bytes ] [ underlying>> ] bi* [ "double" heap-size * ] [ underlying>> ] bi*
resize-byte-array resize-byte-array
] 2bi ] 2bi
float-array boa ; float-array boa ;
@ -58,13 +50,13 @@ INSTANCE: float-array sequence
1 <float-array> [ set-first ] keep ; flushable 1 <float-array> [ set-first ] keep ; flushable
: 2float-array ( x y -- array ) : 2float-array ( x y -- array )
T{ float-array f 0 B{ } } 2sequence ; flushable T{ float-array } 2sequence ; flushable
: 3float-array ( x y z -- array ) : 3float-array ( x y z -- array )
T{ float-array f 0 B{ } } 3sequence ; flushable T{ float-array } 3sequence ; flushable
: 4float-array ( w x y z -- array ) : 4float-array ( w x y z -- array )
T{ float-array f 0 B{ } } 4sequence ; flushable T{ float-array } 4sequence ; flushable
: F{ ( parsed -- parsed ) : F{ ( parsed -- parsed )
\ } [ >float-array ] parse-literal ; parsing \ } [ >float-array ] parse-literal ; parsing