basis/specialized-vectors/specialized-vectors.factor

   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 compiler.units functors growable kernel lexer math namespaces
   5 parser prettyprint.custom sequences specialized-arrays
   6 specialized-arrays.private strings vocabs vocabs.parser
   7 vocabs.generated fry make ;
   8 QUALIFIED: vectors.functor
   9 IN: specialized-vectors
  10
  11 <PRIVATE
  12
  13 FUNCTOR: define-vector ( T -- )
  14
  15 V   DEFINES-CLASS ${T}-vector
  16
  17 A   IS      ${T}-array
  18 <A> IS      <${A}>
  19
  20 >V  DEFERS >${V}
  21 V{  DEFINES ${V}{
  22
  23 WHERE
  24
  25 V A <A> vectors.functor:define-vector
  26
  27 M: V contract 2drop ; inline
  28
  29 M: V element-size drop \ T heap-size ; inline
  30
  31 M: V pprint-delims drop \ V{ \ } ;
  32
  33 M: V >pprint-sequence ;
  34
  35 M: V pprint* pprint-object ;
  36
  37 SYNTAX: V{ \ } [ >V ] parse-literal ;
  38
  39 INSTANCE: V growable
  40
  41 ;FUNCTOR
  42
  43 : specialized-vector-vocab ( c-type -- vocab )
  44     [
  45         "specialized-vectors.instances." %
  46         [ vocabulary>> % "." % ]
  47         [ name>> % ]
  48         bi
  49     ] "" make ;
  50
  51 PRIVATE>
  52
  53 : define-vector-vocab ( type -- vocab )
  54     underlying-type
  55     [ specialized-vector-vocab ] [ '[ _ define-vector ] ] bi
  56     generate-vocab ;
  57
  58 SYNTAX: SPECIALIZED-VECTORS:
  59     ";" parse-tokens [
  60         parse-c-type
  61         [ define-array-vocab use-vocab ]
  62         [ define-vector-vocab use-vocab ] bi
  63     ] each ;
  64
  65 SYNTAX: SPECIALIZED-VECTOR:
  66     scan-c-type
  67     [ define-array-vocab use-vocab ]
  68     [ define-vector-vocab use-vocab ] bi ;