[MLton-commit] r5693
Vesa Karvonen
vesak at mlton.org
Fri Jun 29 05:57:28 PDT 2007
Toys.
----------------------------------------------------------------------
A mltonlib/trunk/org/mlton/vesak/toys/
A mltonlib/trunk/org/mlton/vesak/toys/chameneos/
A mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/
A mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/Build.bgb
A mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/Makefile
A mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.mlb
A mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.sml
A mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/
A mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/
A mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/Build.bgb
A mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/Makefile
A mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.mlb
A mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.sml
A mltonlib/trunk/org/mlton/vesak/toys/common.mk
----------------------------------------------------------------------
Property changes on: mltonlib/trunk/org/mlton/vesak/toys/chameneos/async
___________________________________________________________________
Name: svn:ignore
+ generated
Added: mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/Build.bgb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/Build.bgb 2007-06-29 12:49:57 UTC (rev 5692)
+++ mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/Build.bgb 2007-06-29 12:57:27 UTC (rev 5693)
@@ -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 "Chameneos"
+ :shell "nice -n5 make run")
Added: mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/Makefile
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/Makefile 2007-06-29 12:49:57 UTC (rev 5692)
+++ mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/Makefile 2007-06-29 12:57:27 UTC (rev 5693)
@@ -0,0 +1,9 @@
+# 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 := chameneos
+args := 5000000
+
+include ../../common.mk
Property changes on: mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/Makefile
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.mlb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.mlb 2007-06-29 12:49:57 UTC (rev 5692)
+++ mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.mlb 2007-06-29 12:57:27 UTC (rev 5693)
@@ -0,0 +1,13 @@
+(* 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
+ $(MLTON_LIB)/com/ssh/async/unstable/lib.mlb
+
+ chameneos.sml
+in
+end
Property changes on: mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.mlb
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.sml 2007-06-29 12:49:57 UTC (rev 5692)
+++ mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.sml 2007-06-29 12:57:27 UTC (rev 5693)
@@ -0,0 +1,51 @@
+(* 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 a translation of a Chameneos toy benchmark
+ * implementation by Tom Pledger for Haskell, from the Computer Language
+ * Benchmarks Game, using a library for portable asynchronous programming
+ * in SML. The Async library does not use threads or processes of any
+ * kind. Measure the performance yourself!
+ *)
+
+open Async
+
+datatype color = R | B | Y
+
+val compl =
+ fn B&B => B | B&R => Y | B&Y => R
+ | R&B => Y | R&R => R | R&Y => B
+ | Y&B => R | Y&R => B | Y&Y => Y
+
+val mp = MVar.new ()
+val wake = MVar.new ()
+
+val subCols = [B, R, Y]
+
+fun arrive tally color =
+ when (MVar.take mp)
+ (fn {quota = 0, done = d, waiter = w} =>
+ if length d = length subCols
+ then println (Int.toString (foldl op + tally d))
+ else MVar.fill mp {quota = 0, done = tally::d, waiter = w}
+ | {waiter = NONE, done = d, quota = q} =>
+ (MVar.fill mp {waiter = SOME color, done = d, quota = q}
+ ; when (MVar.take wake) (arrive (tally+1)))
+ | {quota = q, waiter = SOME color0, done = d} => let
+ val color = compl (color & color0)
+ in MVar.fill wake color
+ ; MVar.fill mp {quota = q-1, waiter = NONE, done = d}
+ ; arrive (tally+1) color
+ end)
+
+val n = valOf (Int.fromString (hd (CommandLine.arguments ()))) handle _ => 1
+
+val () =
+ (MVar.fill mp {quota = n, waiter = NONE, done = []}
+ ; app (arrive 0) subCols
+ ; arrive 0 B
+ ; Handler.runAll ())
Property changes on: mltonlib/trunk/org/mlton/vesak/toys/chameneos/async/chameneos.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Property changes on: mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async
___________________________________________________________________
Name: svn:ignore
+ generated
Added: mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/Build.bgb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/Build.bgb 2007-06-29 12:49:57 UTC (rev 5692)
+++ mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/Build.bgb 2007-06-29 12:57:27 UTC (rev 5693)
@@ -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 "Cheap Concurrency"
+ :shell "nice -n5 make run")
Added: mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/Makefile
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/Makefile 2007-06-29 12:49:57 UTC (rev 5692)
+++ mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/Makefile 2007-06-29 12:57:27 UTC (rev 5693)
@@ -0,0 +1,9 @@
+# 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 := cheap-concurrency
+args := 15000
+
+include ../../common.mk
Property changes on: mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/Makefile
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.mlb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.mlb 2007-06-29 12:49:57 UTC (rev 5692)
+++ mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.mlb 2007-06-29 12:57:27 UTC (rev 5693)
@@ -0,0 +1,13 @@
+(* 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
+ $(MLTON_LIB)/com/ssh/async/unstable/lib.mlb
+
+ cheap-concurrency.sml
+in
+end
Property changes on: mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.mlb
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.sml 2007-06-29 12:49:57 UTC (rev 5692)
+++ mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.sml 2007-06-29 12:57:27 UTC (rev 5693)
@@ -0,0 +1,36 @@
+(* 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 the Cheap Concurrency toy
+ * benchmark, from the "Computer Language Benchmarks Game", using a library
+ * for portable asynchronous programming in SML. This implementation was
+ * inspired by a Haskell implementation by Einar Karttunen, Simon Marlow,
+ * and Don Stewart. The Async library does not use threads or processes
+ * of any kind. Measure the performance yourself!
+ *)
+
+open Async
+
+fun handler im = let
+ val om = MVar.new ()
+in
+ every (MVar.take im) (fn x => (MVar.fill om (x+1)))
+ ; om
+end
+
+val head = MVar.new ()
+val tail = repeat handler 500 head
+
+fun accumulate n sum =
+ if n = 0
+ then println (Int.toString sum)
+ else (MVar.fill head sum
+ ; when (MVar.take tail) (accumulate (n-1)))
+
+val n = valOf (Int.fromString (hd (CommandLine.arguments ()))) handle _ => 1
+
+val () = (accumulate n 0 ; Handler.runAll ())
Property changes on: mltonlib/trunk/org/mlton/vesak/toys/cheap-concurrency/async/cheap-concurrency.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/org/mlton/vesak/toys/common.mk
===================================================================
--- mltonlib/trunk/org/mlton/vesak/toys/common.mk 2007-06-29 12:49:57 UTC (rev 5692)
+++ mltonlib/trunk/org/mlton/vesak/toys/common.mk 2007-06-29 12:57:27 UTC (rev 5693)
@@ -0,0 +1,66 @@
+# 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.
+
+##########################################################################
+
+target-arch := $(shell mlton -show path-map | awk '/^TARGET_ARCH/ {print $$2}')
+target-os := $(shell mlton -show path-map | awk '/^TARGET_OS/ {print $$2}')
+target-id := $(target-arch)-$(target-os)
+
+gen-dir := generated/$(target-id)
+
+mlb-path-map := $(gen-dir)/mlb-path-map
+
+exe := $(gen-dir)/$(name)
+
+ifeq ($(target-os),mingw)
+link-opt :=
+else
+link-opt := -link-opt -ldl
+endif
+
+##########################################################################
+
+.PHONY : all clean help run
+
+help :
+ @echo "Targets:"
+ @echo " all Builds the toy benchmark"
+ @echo " run Runs the toy benchmark"
+ @echo " clean Removes generated files"
+ @echo " help You are reading it"
+
+all : $(exe)
+
+clean :
+ rm -rf $(gen-dir)
+
+run : $(exe)
+ bash -c 'time $(exe) $(args)'
+
+##########################################################################
+
+$(mlb-path-map) : Makefile
+ mkdir -p $(@D)
+ echo 'MLTON_LIB $(shell cd ../../../../../.. && pwd)' > $@
+ echo 'SML_COMPILER mlton' >> $@
+
+$(exe) : $(name).mlb $(mlb-path-map)
+ mlton -stop f -mlb-path-map $(mlb-path-map) $< \
+ | sed $$'s#\r##g' \
+ | awk 'BEGIN { srcs = "" ; printf "$@ :" } \
+ { srcs = srcs $$1 ":\n" ; printf " " $$1 } \
+ END { printf "\n" srcs }' \
+ > $@.dep
+ mlton -mlb-path-map $(mlb-path-map) \
+ -prefer-abs-paths true \
+ -show-def-use $@.du \
+ $(link-opt) \
+ -output $@ \
+ $<
+
+##########################################################################
+
+include $(wildcard $(gen-dir)/*.dep)
More information about the MLton-commit
mailing list