More efficient float arrayss; 15% improvement on spectral-norm

core/alien/c-types/c-types.factor

@@ -151,7 +151,8 @@ M: byte-array byte-length length ;
     swap dup length memcpy ;
 
 : (define-nth) ( word type quot -- )
-    >r heap-size [ rot * ] swap prefix r> append define-inline ;
+    >r heap-size [ rot * >fixnum ] swap prefix
+    r> append define-inline ;
 
 : nth-word ( name vocab -- word )
     >r "-nth" append r> create ;

extra/float-arrays/float-arrays.factor

@@ -9,16 +9,8 @@ TUPLE: float-array
 { length array-capacity read-only }
 { underlying byte-array read-only } ;
 
-<PRIVATE
-
-: floats>bytes 8 * ; inline
-
-: float-array@ underlying>> swap >fixnum floats>bytes ; inline
-
-PRIVATE>
-
 : <float-array> ( n -- float-array )
-    dup floats>bytes <byte-array> float-array boa ; inline
+    dup "double" <c-array> float-array boa ; inline
 
 M: float-array clone
     [ length>> ] [ underlying>> clone ] bi float-array boa ;
@@ -26,13 +18,13 @@ M: float-array clone
 M: float-array length length>> ;
 
 M: float-array nth-unsafe
-    float-array@ alien-double ;
+    underlying>> double-nth ;
 
 M: float-array set-nth-unsafe
-    [ >float ] 2dip float-array@ set-alien-double ;
+    [ >float ] 2dip underlying>> set-double-nth ;
 
 : >float-array ( seq -- float-array )
-    T{ float-array f 0 B{ } } clone-like ; inline
+    T{ float-array } clone-like ; inline
 
 M: float-array like
     drop dup float-array? [ >float-array ] unless ;
@@ -45,7 +37,7 @@ M: float-array equal?
 
 M: float-array resize
     [ drop ] [
-        [ floats>bytes ] [ underlying>> ] bi*
+        [ "double" heap-size * ] [ underlying>> ] bi*
         resize-byte-array
     ] 2bi
     float-array boa ;
@@ -58,13 +50,13 @@ INSTANCE: float-array sequence
     1 <float-array> [ set-first ] keep ; flushable
 
 : 2float-array ( x y -- array )
-    T{ float-array f 0 B{ } } 2sequence ; flushable
+    T{ float-array } 2sequence ; flushable
 
 : 3float-array ( x y z -- array )
-    T{ float-array f 0 B{ } } 3sequence ; flushable
+    T{ float-array } 3sequence ; flushable
 
 : 4float-array ( w x y z -- array )
-    T{ float-array f 0 B{ } } 4sequence ; flushable
+    T{ float-array } 4sequence ; flushable
 
 : F{ ( parsed -- parsed )
     \ } [ >float-array ] parse-literal ; parsing