extra/float-vectors/float-vectors.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: arrays kernel kernel.private math sequences\r
   4 sequences.private growable float-arrays prettyprint.backend\r
   5 parser accessors ;\r
   6 IN: float-vectors\r
   7 \r
   8 TUPLE: float-vector\r
   9 { "underlying" float-array }\r
  10 { "length" array-capacity } ;\r
  11 \r
  12 <PRIVATE\r
  13 \r
  14 : float-array>vector ( float-array length -- float-vector )\r
  15     float-vector boa ; inline\r
  16 \r
  17 PRIVATE>\r
  18 \r
  19 : <float-vector> ( n -- float-vector )\r
  20     0.0 <float-array> 0 float-array>vector ; inline\r
  21 \r
  22 : >float-vector ( seq -- float-vector )\r
  23     T{ float-vector f F{ } 0 } clone-like ;\r
  24 \r
  25 M: float-vector like\r
  26     drop dup float-vector? [\r
  27         dup float-array?\r
  28         [ dup length float-array>vector ] [ >float-vector ] if\r
  29     ] unless ;\r
  30 \r
  31 M: float-vector new-sequence\r
  32     drop [ 0.0 <float-array> ] keep >fixnum float-array>vector ;\r
  33 \r
  34 M: float-vector equal?\r
  35     over float-vector? [ sequence= ] [ 2drop f ] if ;\r
  36 \r
  37 M: float-array new-resizable drop <float-vector> ;\r
  38 \r
  39 INSTANCE: float-vector growable\r
  40 \r
  41 : FV{ \ } [ >float-vector ] parse-literal ; parsing\r
  42 \r
  43 M: float-vector >pprint-sequence ;\r
  44 \r
  45 M: float-vector pprint-delims drop \ FV{ \ } ;\r