steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

benchmark.spectral-norm: use unsafe sequence ops again, use TYPED: instead of HINTS:

release
Slava Pestov 2010-04-14 21:50:17 -07:00
parent 008ec8f40f
commit 829b7c8904
1 changed files with 5 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
extra/benchmark/spectral-norm/spectral-norm.factor
View File

@ -1,8 +1,8 @@
! Factor port of ! Factor port of
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all ! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
USING: alien.c-types specialized-arrays kernel math USING: alien.c-types specialized-arrays kernel math
math.functions math.vectors sequences prettyprint words hints math.functions math.vectors sequences sequences.private
locals ; prettyprint words typed locals ;
SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: double
IN: benchmark.spectral-norm IN: benchmark.spectral-norm
@ -19,13 +19,13 @@ IN: benchmark.spectral-norm
+ 1 + recip ; inline + 1 + recip ; inline
: (eval-A-times-u) ( u i j -- x ) : (eval-A-times-u) ( u i j -- x )
[ swap nth ] [ eval-A ] bi-curry bi* * ; inline [ swap nth-unsafe ] [ eval-A ] bi-curry bi* * ; inline
: eval-A-times-u ( n u -- seq ) : eval-A-times-u ( n u -- seq )
[ (eval-A-times-u) ] inner-loop ; inline [ (eval-A-times-u) ] inner-loop ; inline
: (eval-At-times-u) ( u i j -- x ) : (eval-At-times-u) ( u i j -- x )
[ swap nth ] [ swap eval-A ] bi-curry bi* * ; inline [ swap nth-unsafe ] [ swap eval-A ] bi-curry bi* * ; inline
: eval-At-times-u ( u n -- seq ) : eval-At-times-u ( u n -- seq )
[ (eval-At-times-u) ] inner-loop ; inline [ (eval-At-times-u) ] inner-loop ; inline
@ -43,11 +43,9 @@ IN: benchmark.spectral-norm
[ n eval-AtA-times-u ] keep [ n eval-AtA-times-u ] keep
] times ; inline ] times ; inline
: spectral-norm ( n -- norm ) TYPED: spectral-norm ( n: fixnum -- norm )
u/v [ v. ] [ norm-sq ] bi /f sqrt ; u/v [ v. ] [ norm-sq ] bi /f sqrt ;
HINTS: spectral-norm fixnum ;
: spectral-norm-main ( -- ) : spectral-norm-main ( -- )
2000 spectral-norm . ; 2000 spectral-norm . ;