2010-02-24 10:50:31 -05:00
|
|
|
! Copyright (C) 2008, 2010 Slava Pestov.
|
2008-11-14 21:18:16 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2010-02-24 02:18:41 -05:00
|
|
|
USING: accessors alien alien.c-types alien.parser assocs
|
|
|
|
compiler.units functors growable kernel lexer math namespaces
|
|
|
|
parser prettyprint.custom sequences specialized-arrays
|
2009-10-19 05:41:53 -04:00
|
|
|
specialized-arrays.private strings vocabs vocabs.parser
|
|
|
|
vocabs.generated fry make ;
|
2010-06-08 16:15:04 -04:00
|
|
|
FROM: sequences.private => nth-unsafe ;
|
2010-06-08 18:00:11 -04:00
|
|
|
FROM: specialized-arrays.private => nth-c-ptr direct-like ;
|
2009-09-09 23:33:34 -04:00
|
|
|
QUALIFIED: vectors.functor
|
2008-11-14 21:18:16 -05:00
|
|
|
IN: specialized-vectors
|
2009-09-09 23:33:34 -04:00
|
|
|
|
|
|
|
<PRIVATE
|
|
|
|
|
|
|
|
FUNCTOR: define-vector ( T -- )
|
|
|
|
|
|
|
|
V DEFINES-CLASS ${T}-vector
|
|
|
|
|
|
|
|
A IS ${T}-array
|
|
|
|
<A> IS <${A}>
|
2010-06-08 18:00:11 -04:00
|
|
|
<direct-A> IS <direct-${A}>
|
2009-09-09 23:33:34 -04:00
|
|
|
|
|
|
|
>V DEFERS >${V}
|
|
|
|
V{ DEFINES ${V}{
|
|
|
|
|
|
|
|
WHERE
|
|
|
|
|
|
|
|
V A <A> vectors.functor:define-vector
|
|
|
|
|
2010-01-24 23:16:10 -05:00
|
|
|
M: V contract 2drop ; inline
|
2009-09-09 23:33:34 -04:00
|
|
|
|
2010-02-24 10:50:31 -05:00
|
|
|
M: V element-size drop \ T heap-size ; inline
|
2009-09-09 23:33:34 -04:00
|
|
|
|
|
|
|
M: V pprint-delims drop \ V{ \ } ;
|
|
|
|
|
|
|
|
M: V >pprint-sequence ;
|
|
|
|
|
|
|
|
M: V pprint* pprint-object ;
|
|
|
|
|
2010-06-08 16:40:07 -04:00
|
|
|
M: V >c-ptr underlying>> underlying>> ; inline
|
|
|
|
M: V byte-length [ length ] [ element-size ] bi * ; inline
|
|
|
|
|
2010-06-08 18:00:11 -04:00
|
|
|
M: V direct-like drop <direct-A> ; inline
|
|
|
|
M: V nth-c-ptr underlying>> nth-c-ptr ; inline
|
|
|
|
|
2009-09-09 23:33:34 -04:00
|
|
|
SYNTAX: V{ \ } [ >V ] parse-literal ;
|
|
|
|
|
|
|
|
INSTANCE: V growable
|
|
|
|
|
|
|
|
;FUNCTOR
|
|
|
|
|
2009-10-19 05:41:53 -04:00
|
|
|
: specialized-vector-vocab ( c-type -- vocab )
|
|
|
|
[
|
|
|
|
"specialized-vectors.instances." %
|
|
|
|
[ vocabulary>> % "." % ]
|
|
|
|
[ name>> % ]
|
|
|
|
bi
|
|
|
|
] "" make ;
|
2009-09-09 23:33:34 -04:00
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
2010-06-08 16:15:04 -04:00
|
|
|
: push-new ( vector -- new )
|
|
|
|
[ length ] keep ensure nth-unsafe ; inline
|
|
|
|
|
2009-09-10 15:46:26 -04:00
|
|
|
: define-vector-vocab ( type -- vocab )
|
2009-09-09 23:33:34 -04:00
|
|
|
underlying-type
|
2009-09-10 15:46:26 -04:00
|
|
|
[ specialized-vector-vocab ] [ '[ _ define-vector ] ] bi
|
|
|
|
generate-vocab ;
|
2009-09-09 23:33:34 -04:00
|
|
|
|
2009-10-19 05:41:53 -04:00
|
|
|
SYNTAX: SPECIALIZED-VECTORS:
|
2010-03-01 01:06:47 -05:00
|
|
|
";" [
|
2009-10-19 05:41:53 -04:00
|
|
|
parse-c-type
|
|
|
|
[ define-array-vocab use-vocab ]
|
|
|
|
[ define-vector-vocab use-vocab ] bi
|
2010-03-01 01:06:47 -05:00
|
|
|
] each-token ;
|
2009-10-19 05:41:53 -04:00
|
|
|
|
2009-09-09 23:33:34 -04:00
|
|
|
SYNTAX: SPECIALIZED-VECTOR:
|
2009-10-19 05:41:53 -04:00
|
|
|
scan-c-type
|
2009-09-09 23:33:34 -04:00
|
|
|
[ define-array-vocab use-vocab ]
|
|
|
|
[ define-vector-vocab use-vocab ] bi ;
|