1 ! Copyright (C) 2008, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.parser assocs
4 classes compiler.units functors growable kernel lexer math
5 namespaces parser prettyprint.custom sequences
6 specialized-arrays specialized-arrays.private strings
7 vocabs vocabs.loader vocabs.parser vocabs.generated fry make ;
8 FROM: sequences.private => nth-unsafe ;
9 FROM: specialized-arrays.private => nth-c-ptr direct-like ;
10 QUALIFIED: vectors.functor
11 IN: specialized-vectors
13 MIXIN: specialized-vector
17 FUNCTOR: define-vector ( T -- )
19 V DEFINES-CLASS ${T}-vector
24 <direct-A> IS <direct-${A}>
31 V A <A> vectors.functor:define-vector
33 M: V contract 2drop ; inline
35 M: V element-size drop \ T heap-size ; inline
37 M: V pprint-delims drop \ V{ \ } ;
39 M: V >pprint-sequence ;
41 M: V pprint* pprint-object ;
43 M: V >c-ptr underlying>> underlying>> ; inline
44 M: V byte-length [ length ] [ element-size ] bi * ; inline
46 M: V direct-like drop <direct-A> ; inline
47 M: V nth-c-ptr underlying>> nth-c-ptr ; inline
50 drop dup A instance? [
51 dup V instance? [ [ >c-ptr ] [ length>> ] bi <direct-A> ] [ >A ] if
54 SYNTAX: V{ \ } [ >V ] parse-literal ;
56 INSTANCE: V specialized-vector
61 : specialized-vector-vocab ( c-type -- vocab )
63 "specialized-vectors.instances." %
64 [ vocabulary>> % "." % ]
71 : push-new ( vector -- new )
72 [ length ] keep ensure nth-unsafe ; inline
74 : define-vector-vocab ( type -- vocab )
76 [ specialized-vector-vocab ] [ '[ _ define-vector ] ] bi
79 SYNTAX: SPECIALIZED-VECTORS:
82 [ define-array-vocab use-vocab ]
83 [ define-vector-vocab use-vocab ] bi
86 SYNTAX: SPECIALIZED-VECTOR:
88 [ define-array-vocab use-vocab ]
89 [ define-vector-vocab use-vocab ] bi ;
91 { "specialized-vectors" "mirrors" } "specialized-vectors.mirrors" require-when