[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