-USING: help.markup help.syntax byte-arrays alien ;
+USING: help.markup help.syntax byte-arrays alien math sequences ;
IN: specialized-arrays
HELP: SPECIALIZED-ARRAY:
{ 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
{ { $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."
\ 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
+
<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
: <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
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 ;
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
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
A IS ${T}-array
<A> IS <${A}>
+<direct-A> IS <direct-${A}>
>V DEFERS >${V}
V{ DEFINES ${V}{
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