[MLton-commit] r5773

Vesa Karvonen vesak at mlton.org
Fri Jul 13 05:54:15 PDT 2007


Split to multiple files for clarity.
----------------------------------------------------------------------

U   mltonlib/trunk/org/mlton/vesak/toys/simplify/Makefile
A   mltonlib/trunk/org/mlton/vesak/toys/simplify/bench.sml
A   mltonlib/trunk/org/mlton/vesak/toys/simplify/rational.sml
U   mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.mlb
U   mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml

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

Modified: mltonlib/trunk/org/mlton/vesak/toys/simplify/Makefile
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/simplify/Makefile	2007-07-13 02:11:19 UTC (rev 5772)
+++ mltonlib/trunk/org/mlton/vesak/toys/simplify/Makefile	2007-07-13 12:54:14 UTC (rev 5773)
@@ -4,7 +4,7 @@
 # See the LICENSE file or http://mlton.org/License for details.
 
 name := simplify
-args := 1000000
+args := 10000000
 
 root := ../../../../..
 

Copied: mltonlib/trunk/org/mlton/vesak/toys/simplify/bench.sml (from rev 5760, mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml)
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml	2007-07-11 15:05:16 UTC (rev 5760)
+++ mltonlib/trunk/org/mlton/vesak/toys/simplify/bench.sml	2007-07-13 12:54:14 UTC (rev 5773)
@@ -0,0 +1,21 @@
+(* Copyright (C) 2007 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.
+ *)
+
+(* Shorthand *)
+val ` = NUM o INT
+
+(* Naïve Benchmark
+ *
+ * NOTES:
+ * - Seems not to be eliminated by MLton, but wouldn't count on it.
+ * - I would assume that the // constructor or rational gets eliminated by
+ *   MLton, but I haven't verified this.
+ *)
+val expr = $"x" *` (`12 *` `0 +` (`23 +` `8) +` $"y")
+
+val n = valOf (Int.fromString (hd (CommandLine.arguments ())))
+
+val () = repeat (fn () => ignore (simplify expr)) n ()

Copied: mltonlib/trunk/org/mlton/vesak/toys/simplify/rational.sml (from rev 5760, mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml)
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml	2007-07-11 15:05:16 UTC (rev 5760)
+++ mltonlib/trunk/org/mlton/vesak/toys/simplify/rational.sml	2007-07-13 12:54:14 UTC (rev 5773)
@@ -0,0 +1,46 @@
+(* Copyright (C) 2007 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.
+ *)
+
+(* Silly implementation of rational numbers
+ *
+ * HINT: Someone should really implement a nice lib for rational numbers!
+ *)
+
+infix 7 */
+infix 6 +/
+infix 0 //
+
+datatype rat = INT of IntInf.t | // of IntInf.t Sq.t
+
+val canon =
+ fn 0 // _     => INT 0
+  | r as INT _ => r
+  | n // d     => let
+       fun gcd (a, 0) = a
+         | gcd (a, b) = gcd (b, a mod b)
+
+       val c = gcd (n, d)
+    in
+       if c=d then INT (n div c) else n div c // d div c
+    end
+
+val op +/ = let
+   fun sym i n d = n + i * d // d
+in
+   fn (INT l, INT r) => INT (l + r)
+    | (INT i,  n//d) => sym i n d
+    | (n//d,  INT i) => sym i n d
+    | (n//d,   m//e) => canon (if d=e then n+m // d else n*e + m*d // d*e)
+end
+
+val op */ = let
+   fun sym i n d = canon (i*n // d)
+in
+   fn (INT l, INT r) => INT (l * r)
+    | (INT i,  n//d) => sym i n d
+    | (n//d,  INT i) => sym i n d
+    | (n//d,   m//e) => canon (n*m // d*e)
+end

Modified: mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.mlb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.mlb	2007-07-13 02:11:19 UTC (rev 5772)
+++ mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.mlb	2007-07-13 12:54:14 UTC (rev 5773)
@@ -11,7 +11,9 @@
       "sequenceNonUnit error"
       "warnUnused true"
    in
+      rational.sml
       simplify.sml
+      bench.sml
    end
 in
 end

Modified: mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml	2007-07-13 02:11:19 UTC (rev 5772)
+++ mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml	2007-07-13 12:54:14 UTC (rev 5773)
@@ -12,64 +12,16 @@
  *   [http://groups.google.com/group/comp.lang.functional/msg/75963bc5d77123b9]
  *)
 
-(* Silly implementation of rational numbers
- *
- * HINT: Someone should really implement a nice lib for rational numbers!
- *)
-datatype rational =
-   INT of IntInf.t
- | //  of IntInf.t * IntInf.t
+infix 7 *:
+infix 6 +:
 
-infix 7 */
-infix 6 +/
-infix //
-
-fun gcd (a, b) : IntInf.t = if 0 = b then a else gcd (b, a mod b)
-
-val normalize =
- fn 0 // _     => INT 0
-  | r as INT _ => r
-  | n // d     => let
-       val c = gcd (n, d)
-    in
-       if c = d
-       then INT (n div c)
-       else n div c // d div c
-    end
-
-val op +/ = let
-   fun sym i n d = n + i * d // d
-in
-   fn (INT l,   INT r) => INT (l + r)
-    | (INT i,  n // d) => sym i n d
-    | (n // d,  INT i) => sym i n d
-    | (n // d, m // e) =>
-      normalize (if d = e then n + m // d else n*e + m*d // d*e)
-end
-
-val op */ = let
-   fun sym i n d = normalize (i*n // d)
-in
-   fn (INT l,   INT r) => INT (l * r)
-    | (INT i,  n // d) => sym i n d
-    | (n // d,  INT i) => sym i n d
-    | (n // d, m // e) => normalize (n*m // d*e)
-end
-
-(* Expression datatype *)
-datatype expr =
-   NUM of rational
- | +`  of expr * expr
- | *`  of expr * expr
- | $   of String.t
-
 infix 2 *`
 infix 1 +`
 
-(* Simplifier *)
-infix 7 *:
-infix 6 +:
+(* Expression datatype *)
+datatype expr = NUM of rat | +` of expr Sq.t | *` of expr Sq.t | $ of String.t
 
+(* Simplifier *)
 val rec op +: =
  fn (NUM x,             NUM y) => NUM (x +/ y)
   | (NUM (INT 0),           x) => x
@@ -90,18 +42,3 @@
  fn l +` r => simplify l +: simplify r
   | l *` r => simplify l *: simplify r
   | other  => other
-
-(* Shorthand *)
-val ` = NUM o INT
-
-(* Naïve Benchmark
- *
- * NOTE: Seems not to be eliminated by MLton, but wouldn't count on it.
- * I would assume that the // constructor gets eliminated by MLton, but I
- * haven't verified this.
- *)
-val expr = $"x" *` (`12 *` `0 +` (`23 +` `8) +` $"y")
-
-val n = valOf (Int.fromString (hd (CommandLine.arguments ())))
-
-val () = repeat (fn () => ignore (simplify expr)) n ()




More information about the MLton-commit mailing list