! (c)Joe Groff bsd license
USING: accessors alien alien.c-types alien.data alien.parser arrays
-byte-arrays combinators effects.parser fry generalizations kernel
-lexer locals macros make math math.ranges parser sequences sequences.private ;
+byte-arrays combinators effects.parser fry generalizations grouping kernel
+lexer locals macros make math math.ranges parser sequences
+sequences.generalizations sequences.private ;
FROM: alien.arrays => array-length ;
IN: alien.data.map
-ERROR: bad-data-map-input-length byte-length iter-size remainder ;
-
<PRIVATE
: <displaced-direct-array> ( displacement bytes length type -- direct-array )
{ iter-length fixnum read-only }
{ iter-count fixnum read-only } ;
-ERROR: bad-data-map-param param remainder ;
-
M: data-map-param length
iter-count>> ; inline
INSTANCE: data-map-param immutable-sequence
-: c-type-count ( in/out -- c-type count iter-length )
- dup array? [ unclip swap array-length >fixnum ] [ 1 ] if
- 2dup swap heap-size * >fixnum ; inline
+: c-type-count ( in/out -- c-type count )
+ dup array? [ unclip swap array-length >fixnum ] [ 1 ] if ; inline
-MACRO: >param ( in -- quot: ( array -- param ) )
- c-type-count '[
+: c-type-iter-length ( c-type count -- iter-length )
+ swap heap-size * >fixnum ; inline
+
+: [>c-type-param] ( c-type count -- quot )
+ 2dup c-type-iter-length '[
[ _ _ ] dip
[ ]
[ >c-ptr ]
data-map-param boa
] ;
-MACRO: alloc-param ( out -- quot: ( len -- param ) )
- c-type-count dup '[
+: [>object-param] ( class count -- quot )
+ nip '[ _ <sliced-groups> ] ;
+
+: [>param] ( type -- quot )
+ c-type-count over c-type-word?
+ [ [>c-type-param] ] [ [>object-param] ] if ;
+
+MACRO: >param ( in -- quot: ( array -- param ) )
+ [>param] ;
+
+: [alloc-c-type-param] ( c-type count -- quot )
+ 2dup c-type-iter-length dup '[
[ _ _ ] dip
[
_ * >fixnum [ (byte-array) dup ] keep
data-map-param boa
] ;
+: [alloc-object-param] ( type count -- quot )
+ "Factor sequences as data-map outputs not supported" throw ;
+
+: [alloc-param] ( type -- quot )
+ c-type-count over c-type-word?
+ [ [alloc-c-type-param] ] [ [alloc-object-param] ] if ;
+
+MACRO: alloc-param ( out -- quot: ( len -- param ) )
+ [alloc-param] ;
+
MACRO: unpack-params ( ins -- )
- [ c-type-count drop nip '[ _ firstn-unsafe ] ] map '[ _ spread ] ;
+ [ c-type-count nip '[ _ firstn-unsafe ] ] map '[ _ spread ] ;
MACRO: pack-params ( outs -- )
- [ ] [ c-type-count drop nip dup [ [ ndip _ ] dip set-firstn ] 3curry ] reduce
+ [ ] [ c-type-count nip dup [ [ ndip _ ] dip set-firstn ] 3curry ] reduce
fry [ call ] compose ;
:: [data-map] ( ins outs param-quot -- quot )
: parse-data-map-effect ( accum -- accum )
")" parse-effect
- [ in>> [ parse-c-type ] map parsed ]
- [ out>> [ parse-c-type ] map parsed ] bi ;
+ [ in>> [ (parse-c-type) ] map suffix! ]
+ [ out>> [ (parse-c-type) ] map suffix! ] bi ;
PRIVATE>
SYNTAX: data-map(
- parse-data-map-effect \ data-map parsed ;
+ parse-data-map-effect \ data-map suffix! ;
SYNTAX: data-map!(
- parse-data-map-effect \ data-map! parsed ;
+ parse-data-map-effect \ data-map! suffix! ;