specialized-arrays, specialized-vectors: add direct-slice, direct-head, direct-tail, etc. words for creating specialized-arrays over subsets of specialized sequences

db4
Joe Groff 2010-06-08 15:00:11 -07:00
parent c8bb9b3381
commit 5ca4c343c4
4 changed files with 69 additions and 2 deletions

View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax byte-arrays alien ;
USING: help.markup help.syntax byte-arrays alien math sequences ;
IN: specialized-arrays
HELP: SPECIALIZED-ARRAY:
@ -13,6 +13,28 @@ HELP: SPECIALIZED-ARRAYS:
{ POSTPONE: SPECIALIZED-ARRAY: POSTPONE: SPECIALIZED-ARRAYS: } related-words
HELP: direct-slice
{ $values { "from" integer } { "to" integer } { "seq" "a specialized array" } { "seq'" "a new specialized array" } }
{ $description "Constructs a new specialized array of the same type as " { $snippet "seq" } " sharing the same underlying memory as the subsequence of " { $snippet "seq" } " from elements " { $snippet "from" } " up to but not including " { $snippet "to" } ". Like " { $link slice } ", raises an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." } ;
HELP: direct-head
{ $values { "seq" "a specialized array" } { "n" integer } { "seq'" "a new specialized array" } }
{ $description "Constructs a new specialized array of the same type as " { $snippet "seq" } " sharing the same underlying memory as the first " { $snippet "n" } " elements of " { $snippet "seq" } ". Like " { $link head } ", raises an error if " { $snippet "n" } " is out of bounds." } ;
HELP: direct-tail
{ $values { "seq" "a specialized array" } { "n" integer } { "seq'" "a new specialized array" } }
{ $description "Constructs a new specialized array of the same type as " { $snippet "seq" } " sharing the same underlying memory as " { $snippet "seq" } " without the first " { $snippet "n" } " elements. Like " { $link tail } ", raises an error if " { $snippet "n" } " is out of bounds." } ;
HELP: direct-head*
{ $values { "seq" "a specialized array" } { "n" integer } { "seq'" "a new specialized array" } }
{ $description "Constructs a new specialized array of the same type as " { $snippet "seq" } " sharing the same underlying memory as " { $snippet "seq" } " without the last " { $snippet "n" } " elements. Like " { $link head* } ", raises an error if " { $snippet "n" } " is out of bounds." } ;
HELP: direct-tail*
{ $values { "seq" "a specialized array" } { "n" integer } { "seq'" "a new specialized array" } }
{ $description "Constructs a new specialized array of the same type as " { $snippet "seq" } " sharing the same underlying memory as the last " { $snippet "n" } " elements of " { $snippet "seq" } ". Like " { $link tail* } ", raises an error if " { $snippet "n" } " is out of bounds." } ;
{ direct-slice direct-head direct-tail direct-head* direct-tail* } related-words
ARTICLE: "specialized-array-words" "Specialized array words"
"The " { $link POSTPONE: SPECIALIZED-ARRAY: } " and " { $link POSTPONE: SPECIALIZED-ARRAYS: } " parsing words generate specialized array types if they haven't been generated already and add the following words to the vocabulary search path, where " { $snippet "T" } " is the C type in question:"
{ $table
@ -25,7 +47,16 @@ ARTICLE: "specialized-array-words" "Specialized array words"
{ { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } }
{ { $snippet "T-array{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } }
}
"Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-arrays.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-ARRAY: } " or " { $link POSTPONE: SPECIALIZED-ARRAYS: } ". This ensures that the vocabulary can get generated the first time it is needed." ;
"Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-arrays.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-ARRAY: } " or " { $link POSTPONE: SPECIALIZED-ARRAYS: } ". This ensures that the vocabulary can get generated the first time it is needed."
$nl
"Additionally, special versions of the standard " { $link <slice> } ", " { $link head } ", and " { $link tail } " sequence operations are provided for specialized arrays to create a new specialized array object sharing storage with a subsequence of an existing array:"
{ $subsections
direct-slice
direct-head
direct-tail
direct-head*
direct-tail*
} ;
ARTICLE: "specialized-array-c" "Passing specialized arrays to C functions"
"If a C function is declared as taking a parameter with a pointer or an array type (for example, " { $snippet "float*" } " or " { $snippet "int[3]" } "), instances of the relevant specialized array can be passed in."

View File

@ -191,3 +191,16 @@ SPECIALIZED-ARRAY: struct-resize-test
\ struct-resize-test-usage forget
] with-compilation-unit
] unit-test
[ int-array{ 4 5 6 } ] [ 3 6 int-array{ 1 2 3 4 5 6 7 8 } direct-slice ] unit-test
[ int-array{ 1 2 3 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head ] unit-test
[ int-array{ 1 2 3 4 5 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head* ] unit-test
[ int-array{ 4 5 6 7 8 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail ] unit-test
[ int-array{ 6 7 8 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail* ] unit-test
[ int-array{ 1 2 3 4 55555 6 7 8 } ] [
int-array{ 1 2 3 4 5 6 7 8 }
3 6 pick direct-slice [ 55555 1 ] dip set-nth
] unit-test

View File

@ -32,6 +32,9 @@ M: not-a-byte-array summary
<PRIVATE
GENERIC: nth-c-ptr ( n seq -- displaced-alien )
GENERIC: direct-like ( alien len exemplar -- seq )
FUNCTOR: define-array ( T -- )
A DEFINES-CLASS ${T}-array
@ -52,6 +55,8 @@ TUPLE: A
: <direct-A> ( alien len -- specialized-array ) A boa ; inline
M: A direct-like drop <direct-A> ; inline
: <A> ( n -- specialized-array )
[ \ T <underlying> ] keep <direct-A> ; inline
@ -71,6 +76,8 @@ M: A length length>> ; inline
M: A nth-unsafe underlying>> \ T alien-element ; inline
M: A nth-c-ptr underlying>> \ T array-accessor drop swap <displaced-alien> ; inline
M: A set-nth-unsafe underlying>> \ T set-alien-element ; inline
: >A ( seq -- specialized-array ) A new clone-like ;
@ -132,6 +139,17 @@ M: pointer underlying-type
PRIVATE>
: direct-slice ( from to seq -- seq' )
check-slice
[ nip nth-c-ptr ]
[ drop swap - ]
[ 2nip ] 3tri direct-like ; inline
: direct-head ( seq n -- seq' ) (head) direct-slice ; inline
: direct-tail ( seq n -- seq' ) (tail) direct-slice ; inline
: direct-head* ( seq n -- seq' ) from-end direct-head ; inline
: direct-tail* ( seq n -- seq' ) from-end direct-tail ; inline
: define-array-vocab ( type -- vocab )
underlying-type
[ specialized-array-vocab ] [ '[ _ define-array ] ] bi

View File

@ -6,6 +6,7 @@ parser prettyprint.custom sequences specialized-arrays
specialized-arrays.private strings vocabs vocabs.parser
vocabs.generated fry make ;
FROM: sequences.private => nth-unsafe ;
FROM: specialized-arrays.private => nth-c-ptr direct-like ;
QUALIFIED: vectors.functor
IN: specialized-vectors
@ -17,6 +18,7 @@ V DEFINES-CLASS ${T}-vector
A IS ${T}-array
<A> IS <${A}>
<direct-A> IS <direct-${A}>
>V DEFERS >${V}
V{ DEFINES ${V}{
@ -38,6 +40,9 @@ M: V pprint* pprint-object ;
M: V >c-ptr underlying>> underlying>> ; inline
M: V byte-length [ length ] [ element-size ] bi * ; inline
M: V direct-like drop <direct-A> ; inline
M: V nth-c-ptr underlying>> nth-c-ptr ; inline
SYNTAX: V{ \ } [ >V ] parse-literal ;
INSTANCE: V growable