Clean up spectral-norm

extra/benchmark/spectral-norm/spectral-norm.factor

@@ -1,48 +1,44 @@
 ! Factor port of
 ! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
 USING: float-arrays kernel math math.functions math.vectors
-sequences sequences.private prettyprint words tools.time hints ;
+sequences sequences.private prettyprint words
+hints locals ;
 IN: benchmark.spectral-norm
 
-: fast-truncate >fixnum >float ; inline
+:: inner-loop ( u n quot -- seq )
+    n [| i |
+        n 0.0 [| j |
+            u i j quot call +
+        ] reduce
+    ] F{ } map-as ; inline
 
 : eval-A ( i j -- n )
     [ >float ] bi@
-    dupd + dup 1+ * 2 /f fast-truncate + 1+
-    recip ; inline
+    [ drop ] [ + [ ] [ 1 + ] bi * 0.5 * ] 2bi
+    + 1 + recip ; inline
 
 : (eval-A-times-u) ( u i j -- x )
-    tuck eval-A >r swap nth-unsafe r> * ; inline
+    tuck [ swap nth-unsafe ] [ eval-A ] 2bi* * ; inline
 
 : eval-A-times-u ( n u -- seq )
-    over [
-        pick 0.0 [
-            swap >r >r 2dup r> (eval-A-times-u) r> +
-        ] reduce nip
-    ] F{ } map-as 2nip ; inline
+    [ (eval-A-times-u) ] inner-loop ; inline
 
 : (eval-At-times-u) ( u i j -- x )
-    tuck swap eval-A >r swap nth-unsafe r> * ; inline
+    tuck [ swap nth-unsafe ] [ swap eval-A ] 2bi* * ; inline
 
-: eval-At-times-u ( n u -- seq )
-    over [
-        pick 0.0 [
-            swap >r >r 2dup r> (eval-At-times-u) r> +
-        ] reduce nip
-    ] F{ } map-as 2nip ; inline
+: eval-At-times-u ( u n -- seq )
+    [ (eval-At-times-u) ] inner-loop ; inline
 
-: eval-AtA-times-u ( n u -- seq )
-    dupd eval-A-times-u eval-At-times-u ; inline
+: eval-AtA-times-u ( u n -- seq )
+    [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline
 
-: u/v ( n -- u v )
-    dup 1.0 <float-array> dup
+:: u/v ( n -- u v )
+    n 1.0 <float-array> dup
     10 [
         drop
-        dupd eval-AtA-times-u
-        2dup eval-AtA-times-u
-        swap
-    ] times
-    rot drop ; inline
+        n eval-AtA-times-u
+        [ n eval-AtA-times-u ] keep
+    ] times ; inline
 
 : spectral-norm ( n -- norm )
     u/v [ v. ] keep norm-sq /f sqrt ;
@@ -50,6 +46,6 @@ IN: benchmark.spectral-norm
 HINTS: spectral-norm fixnum ;
 
 : spectral-norm-main ( -- )
-    2000 spectral-norm . ;
+    5500 spectral-norm . ;
 
 MAIN: spectral-norm-main