[MLton-commit] r6595

[Vesa Karvonen]

Toys, toys, toys.
----------------------------------------------------------------------

A   mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/
A   mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/Build.bgb
A   mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/Makefile
A   mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.mlb
A   mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.sml

----------------------------------------------------------------------

Added: mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/Build.bgb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/Build.bgb	2008-04-20 08:42:05 UTC (rev 6594)
+++ mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/Build.bgb	2008-04-20 15:02:27 UTC (rev 6595)
@@ -0,0 +1,8 @@
+;; Copyright (C) 2008 Vesa Karvonen
+;;
+;; This code is released under the MLton license, a BSD-style license.
+;; See the LICENSE file or http://mlton.org/License for details.
+
+(bg-build
+ :name  "Spectral Norm"
+ :shell "nice -n5 make run")

Added: mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/Makefile
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/Makefile	2008-04-20 08:42:05 UTC (rev 6594)
+++ mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/Makefile	2008-04-20 15:02:27 UTC (rev 6595)
@@ -0,0 +1,13 @@
+# Copyright (C) 2008 Vesa Karvonen
+#
+# This code is released under the MLton license, a BSD-style license.
+# See the LICENSE file or http://mlton.org/License for details.
+
+name := spectral-norm
+args := 5500
+
+root := ../../../../..
+
+mlton-opts := -align 8 -loop-passes 2
+
+include ../common.mk


Property changes on: mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/Makefile
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.mlb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.mlb	2008-04-20 08:42:05 UTC (rev 6594)
+++ mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.mlb	2008-04-20 15:02:27 UTC (rev 6595)
@@ -0,0 +1,18 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+$(SML_LIB)/basis/unsafe.mlb
+$(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
+
+local
+   ann
+      "warnUnused true"
+      "sequenceNonUnit warn"
+   in
+      spectral-norm.sml
+   end
+in
+end


Property changes on: mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.mlb
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.sml	2008-04-20 08:42:05 UTC (rev 6594)
+++ mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.sml	2008-04-20 15:02:27 UTC (rev 6595)
@@ -0,0 +1,30 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+open Array Cvt Iter
+
+val op @ = Unsafe.Array.sub
+val update = Unsafe.Array.update
+
+val n = valOf (Int.fromString (hd (CommandLine.arguments ()))) handle _ => 1
+
+fun aij i j = 1.0 / Real.fromInt ((i+j) * (i+j+1) div 2 + (i+1))
+
+fun timesAv aij u v =
+    upTo n $ (fn i =>
+      update (v, i, reduce 0.0 op + (fn j => aij j i * (u at j)) (upTo n $)))
+
+fun timesAtA u v =
+    case array (n, 0.0) of w => (timesAv aij u w ; timesAv (flip aij) w v)
+
+val u & v = array (n, 1.0) & array (n, 0.0)
+
+val () =
+    (upTo 10 $ (fn _ => (timesAtA u v ; timesAtA v u))
+   ; (println o R#F 9 o Math.sqrt o op /)
+      (fold (fn (i, (vBv, vv)) => (vBv + (u at i) * (v at i), vv + Real.sq (v at i)))
+            (0.0, 0.0)
+            (upTo n $)))


Property changes on: mltonlib/trunk/org/mlton/vesak/toys/spectral-norm/spectral-norm.sml
___________________________________________________________________
Name: svn:eol-style
   + native