[MLton-commit] r5760

Vesa Karvonen vesak at mlton.org
Wed Jul 11 08:05:17 PDT 2007


One more toy.
----------------------------------------------------------------------

A   mltonlib/trunk/org/mlton/vesak/toys/simplify/
A   mltonlib/trunk/org/mlton/vesak/toys/simplify/Build.bgb
A   mltonlib/trunk/org/mlton/vesak/toys/simplify/Makefile
A   mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.mlb
A   mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml

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


Property changes on: mltonlib/trunk/org/mlton/vesak/toys/simplify
___________________________________________________________________
Name: svn:ignore
   + generated


Added: mltonlib/trunk/org/mlton/vesak/toys/simplify/Build.bgb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/simplify/Build.bgb	2007-07-11 14:33:21 UTC (rev 5759)
+++ mltonlib/trunk/org/mlton/vesak/toys/simplify/Build.bgb	2007-07-11 15:05:16 UTC (rev 5760)
@@ -0,0 +1,8 @@
+;; 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.
+
+(bg-build
+ :name  "Simplify"
+ :shell "nice -n5 make run")

Added: mltonlib/trunk/org/mlton/vesak/toys/simplify/Makefile
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/simplify/Makefile	2007-07-11 14:33:21 UTC (rev 5759)
+++ mltonlib/trunk/org/mlton/vesak/toys/simplify/Makefile	2007-07-11 15:05:16 UTC (rev 5760)
@@ -0,0 +1,11 @@
+# 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.
+
+name := simplify
+args := 1000000
+
+root := ../../../../..
+
+include ../common.mk


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

Added: mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.mlb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.mlb	2007-07-11 14:33:21 UTC (rev 5759)
+++ mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.mlb	2007-07-11 15:05:16 UTC (rev 5760)
@@ -0,0 +1,17 @@
+(* 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.
+ *)
+
+local
+   $(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
+
+   ann
+      "sequenceNonUnit error"
+      "warnUnused true"
+   in
+      simplify.sml
+   end
+in
+end


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

Added: mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml	2007-07-11 14:33:21 UTC (rev 5759)
+++ mltonlib/trunk/org/mlton/vesak/toys/simplify/simplify.sml	2007-07-11 15:05:16 UTC (rev 5760)
@@ -0,0 +1,107 @@
+(* 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.
+ *)
+
+(*
+ * This is basically an implementation of Jon Harrop's rewrite simplifier
+ * toy benchmark.  See:
+ *
+ *   [http://groups.google.com/group/comp.lang.lisp/msg/a3ba5d7372a05917]
+ *   [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 //
+
+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 +:
+
+val rec op +: =
+ fn (NUM x,             NUM y) => NUM (x +/ y)
+  | (NUM (INT 0),           x) => x
+  | (x,           NUM (INT 0)) => x
+  | (x,                y +` z) => x +: y +:z
+  | other                      => op +` other
+
+val rec op *: =
+ fn (NUM x,                       NUM y) => NUM (x */ y)
+  | (x as NUM (INT 0),                _) => x
+  | (_,                y as NUM (INT 0)) => y
+  | (NUM (INT 1),                     y) => y
+  | (x,                     NUM (INT 1)) => x
+  | (x,                          y *` z) => x *: y *: z
+  | other                                => op *` other
+
+val rec simplify =
+ 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 ()


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




More information about the MLton-commit mailing list