specialized-arrays, specialized-vectors: add direct-slice, direct-head, direct-tail, etc. words for creating specialized-arrays over subsets of specialized sequences
							parent
							
								
									c8bb9b3381
								
							
						
					
					
						commit
						5ca4c343c4
					
				| 
						 | 
				
			
			@ -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."
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue