basis/float-arrays/float-arrays.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel kernel.private alien.accessors sequences
   4 sequences.private math math.private byte-arrays accessors
   5 alien.c-types parser prettyprint.backend ;
   6 IN: float-arrays
   7
   8 TUPLE: float-array
   9 { length array-capacity read-only }
  10 { underlying byte-array read-only } ;
  11
  12 : <float-array> ( n -- float-array )
  13     dup "double" <c-array> float-array boa ; inline
  14
  15 M: float-array clone
  16     [ length>> ] [ underlying>> clone ] bi float-array boa ;
  17
  18 M: float-array length length>> ;
  19
  20 M: float-array nth-unsafe
  21     underlying>> double-nth ;
  22
  23 M: float-array set-nth-unsafe
  24     [ >float ] 2dip underlying>> set-double-nth ;
  25
  26 : >float-array ( seq -- float-array )
  27     T{ float-array } clone-like ; inline
  28
  29 M: float-array like
  30     drop dup float-array? [ >float-array ] unless ;
  31
  32 M: float-array new-sequence
  33     drop <float-array> ;
  34
  35 M: float-array equal?
  36     over float-array? [ sequence= ] [ 2drop f ] if ;
  37
  38 M: float-array resize
  39     [ drop ] [
  40         [ "double" heap-size * ] [ underlying>> ] bi*
  41         resize-byte-array
  42     ] 2bi
  43     float-array boa ;
  44
  45 M: float-array byte-length length "double" heap-size * ;
  46
  47 INSTANCE: float-array sequence
  48
  49 : 1float-array ( x -- array )
  50     1 <float-array> [ set-first ] keep ; inline
  51
  52 : 2float-array ( x y -- array )
  53     T{ float-array } 2sequence ; inline
  54
  55 : 3float-array ( x y z -- array )
  56     T{ float-array } 3sequence ; inline
  57
  58 : 4float-array ( w x y z -- array )
  59     T{ float-array } 4sequence ; inline
  60
  61 : F{ \ } [ >float-array ] parse-literal ; parsing
  62
  63 M: float-array pprint-delims drop \ F{ \ } ;
  64 M: float-array >pprint-sequence ;
  65 M: float-array pprint* pprint-object ;
  66
  67 USING: hints math.vectors arrays ;
  68
  69 HINTS: vneg { float-array } { array } ;
  70 HINTS: v*n { float-array float } { array object } ;
  71 HINTS: n*v { float float-array } { array object } ;
  72 HINTS: v/n { float-array float } { array object } ;
  73 HINTS: n/v { float float-array } { object array } ;
  74 HINTS: v+ { float-array float-array } { array array } ;
  75 HINTS: v- { float-array float-array } { array array } ;
  76 HINTS: v* { float-array float-array } { array array } ;
  77 HINTS: v/ { float-array float-array } { array array } ;
  78 HINTS: vmax { float-array float-array } { array array } ;
  79 HINTS: vmin { float-array float-array } { array array } ;
  80 HINTS: v. { float-array float-array } { array array } ;
  81 HINTS: norm-sq { float-array } { array } ;
  82 HINTS: norm { float-array } { array } ;
  83 HINTS: normalize { float-array } { array } ;