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

functors: support private words with DEFINES-PRIVATE; use this to make some words generated by math.vectors.simd.functor private

db4
Slava Pestov 2009-09-04 01:21:59 -05:00
parent 55c449c6e2
commit 6b5e40b2fc
2 changed files with 17 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/functors/functors.factor
View File

@ -130,6 +130,8 @@ SYNTAX: DEFERS [ current-vocab create ] (INTERPOLATE) ;
SYNTAX: DEFINES [ create-in ] (INTERPOLATE) ;
SYNTAX: DEFINES-PRIVATE [ begin-private create-in end-private ] (INTERPOLATE) ;
SYNTAX: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ;
DEFER: ;FUNCTOR delimiter

44
basis/math/vectors/simd/functor/functor.factor
View File

@ -12,8 +12,6 @@ FUNCTOR: define-simd-128 ( T -- )
N [ 16 T heap-size /i ]
A DEFINES-CLASS ${T}-${N}
<A> DEFINES <${A}>
(A) DEFINES (${A})
>A DEFINES >${A}
A{ DEFINES ${A}{
@ -21,18 +19,14 @@ NTH [ T dup c-type-getter-boxer array-accessor ]
SET-NTH [ T dup c-setter array-accessor ]
A-rep IS ${A}-rep
A-vv->v-op DEFINES ${A}-vv->v-op
A-v->n-op DEFINES ${A}-v->n-op
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
WHERE
TUPLE: A
{ underlying byte-array read-only initial: $[ 16 <byte-array> ] } ;
: <A> ( -- simd-array ) 16 <byte-array> \ A boa ; inline
: (A) ( -- simd-array ) 16 (byte-array) \ A boa ; inline
M: A clone underlying>> clone \ A boa ; inline
M: A length drop N ; inline
@ -45,7 +39,11 @@ M: A set-nth-unsafe underlying>> SET-NTH call ; inline
M: A like drop dup \ A instance? [ >A ] unless ; inline
M: A new-sequence drop dup N = [ drop (A) ] [ N bad-length ] if ; inline
M: A new-sequence
drop dup N =
[ drop 16 <byte-array> \ A boa ]
[ N bad-length ]
if ; inline
M: A equal? over \ A instance? [ sequence= ] [ 2drop f ] if ;
@ -82,16 +80,14 @@ N/2 [ N 2 / ]
A/2 IS ${T}-${N/2}
A DEFINES-CLASS ${T}-${N}
<A> DEFINES <${A}>
(A) DEFINES (${A})
>A DEFINES >${A}
A{ DEFINES ${A}{
A-deref DEFINES ${A}-deref
A-deref DEFINES-PRIVATE ${A}-deref
A-rep IS ${A/2}-rep
A-vv->v-op DEFINES ${A}-vv->v-op
A-v->n-op DEFINES ${A}-v->n-op
A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
WHERE
@ -102,25 +98,15 @@ TUPLE: A
{ underlying1 byte-array initial: $[ 16 <byte-array> ] read-only }
{ underlying2 byte-array initial: $[ 16 <byte-array> ] read-only } ;
: <A> ( -- simd-array )
16 <byte-array> 16 <byte-array> \ A boa ; inline
: (A) ( -- simd-array )
16 (byte-array) 16 (byte-array) \ A boa ; inline
M: A clone
[ underlying1>> clone ] [ underlying2>> clone ] bi
\ A boa ; inline
M: A length drop N ; inline
<PRIVATE
: A-deref ( n seq -- n' seq' )
over N/2 < [ underlying1>> ] [ [ N/2 - ] dip underlying2>> ] if \ A/2 boa ; inline
PRIVATE>
M: A nth-unsafe A-deref nth-unsafe ; inline
M: A set-nth-unsafe A-deref set-nth-unsafe ; inline
@ -129,7 +115,11 @@ M: A set-nth-unsafe A-deref set-nth-unsafe ; inline
M: A like drop dup \ A instance? [ >A ] unless ; inline
M: A new-sequence drop dup N = [ drop (A) ] [ N bad-length ] if ; inline
M: A new-sequence
drop dup N =
[ drop 16 <byte-array> 16 <byte-array> \ A boa ]
[ N bad-length ]
if ; inline
M: A equal? over \ A instance? [ sequence= ] [ 2drop f ] if ;
@ -145,8 +135,6 @@ M: A pprint* pprint-object ;
INSTANCE: A sequence
<PRIVATE
: A-vv->v-op ( v1 v2 quot -- v3 )
[ [ [ underlying1>> ] bi@ A-rep ] dip call ]
[ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi
@ -158,6 +146,4 @@ INSTANCE: A sequence
[ [ underlying2>> A-rep ] dip call ] 2bi
] dip call ; inline
PRIVATE>
;FUNCTOR