factor/basis/specialized-vectors/specialized-vectors.factor

73 lines
1.5 KiB
Factor

! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types assocs compiler.units functors
growable io kernel lexer namespaces parser prettyprint.custom
sequences specialized-arrays specialized-arrays.private strings
vocabs vocabs.parser ;
QUALIFIED: vectors.functor
IN: specialized-vectors
<PRIVATE
FUNCTOR: define-vector ( T -- )
V DEFINES-CLASS ${T}-vector
A IS ${T}-array
S IS ${T}-sequence
<A> IS <${A}>
>V DEFERS >${V}
V{ DEFINES ${V}{
WHERE
V A <A> vectors.functor:define-vector
M: V contract 2drop ;
M: V byte-length underlying>> byte-length ;
M: V pprint-delims drop \ V{ \ } ;
M: V >pprint-sequence ;
M: V pprint* pprint-object ;
SYNTAX: V{ \ } [ >V ] parse-literal ;
INSTANCE: V growable
INSTANCE: V S
;FUNCTOR
: specialized-vector-vocab ( type -- vocab )
"specialized-vectors.instances." prepend ;
: defining-vector-message ( type -- )
"quiet" get [ drop ] [
"Generating specialized " " vectors..." surround print
] if ;
PRIVATE>
: define-vector-vocab ( type -- vocab )
underlying-type
dup specialized-vector-vocab vocab
[ ] [
[ defining-vector-message ]
[
[
dup specialized-vector-vocab
[ define-vector ] with-current-vocab
] with-compilation-unit
]
[ specialized-vector-vocab ]
tri
] ?if ;
SYNTAX: SPECIALIZED-VECTOR:
scan
[ define-array-vocab use-vocab ]
[ define-vector-vocab use-vocab ] bi ;