diff --git a/examples/Makefile b/examples/Makefile index ff1fa7869..e12489d5a 100644 --- a/examples/Makefile +++ b/examples/Makefile @@ -14,7 +14,8 @@ PROGRAMS= \ dedup \ nqueens \ reverb \ - seam-carve + seam-carve \ + coins DBG_PROGRAMS := $(addsuffix .dbg,$(PROGRAMS)) SYSMPL_PROGRAMS := $(addsuffix .sysmpl,$(PROGRAMS)) diff --git a/examples/src/coins/coins.sml b/examples/src/coins/coins.sml new file mode 100644 index 000000000..91c4bacf0 --- /dev/null +++ b/examples/src/coins/coins.sml @@ -0,0 +1,87 @@ +(* https://github.com/ghc/nofib/blob/f481777acf608c132db47cb8badb618ef39a0d6f/parallel/coins/coins.hs *) + +structure L = List + +datatype AList + = ANil + | ASing of int + | Append of (AList * AList) + +fun lenA (ls : AList) : int = + case ls of + ANil => 0 + | ASing _ => 1 + | Append (l, r) => lenA l + lenA r + +fun append (ls1 : AList) (ls2 : AList) : AList = + case (ls1,ls2) of + (ANil, r) => r + | (l, ANil) => l + | (l, r) => Append (l, r) + +type coin = int * int + +fun payA_seq (amt : int) (coins : coin L.list) : AList = + if amt = 0 + then ASing 1 + else + case coins of + ((c,q) :: coins_rst) => + if c > amt + then payA_seq amt coins_rst + else + let + val coins1 = if q = 1 then coins_rst else (c,q-1) :: coins_rst + val left = payA_seq (amt - c) coins1 + val right = payA_seq amt coins_rst + in + append left right + end + | [] => ANil + +fun payA_par (depth : int) (amt : int) (coins : coin L.list) : AList = + if depth = 0 + then payA_seq amt coins + else if amt = 0 + then ASing 1 + else + case coins of + ((c,q) :: coins_rst) => + if c > amt + then payA_par depth amt coins_rst + else + let + val (coins1,depth1) = if q = 1 + then (coins_rst, depth - 1) + else ((c,q-1) :: coins_rst, depth) + val (left, right) = ForkJoin.par + ( fn _ => payA_par depth1 (amt - c) coins1 + , fn _ => payA_par (depth-1) amt coins_rst + ) + in + append left right + end + | [] => ANil + +val coins_input : coin list = + let + val cs = [250, 100, 25, 10, 5, 1] + val qs = [55, 88, 88, 99, 122, 177] + in + ListPair.zip (cs, qs) + end + + +val amt = CommandLineArgs.parseInt "N" 777 + +(* Sequential *) +val t0 = Time.now () +val result_seq = payA_seq amt coins_input +val t1 = Time.now () +val _ = print ("Sequential: " ^ Int.toString (lenA result_seq) ^ ". Finished in: " ^ Time.fmt 4 (Time.- (t1, t0)) ^ "s.\n") + +(* Parallel *) +val t2 = Time.now () +val result_par = payA_par 3 amt coins_input +val t3 = Time.now () +val _ = print ("Parallel: " ^ Int.toString (lenA result_par) ^ ". Finished in: " ^ Time.fmt 4 (Time.- (t3, t2)) ^ "s.") \ No newline at end of file diff --git a/examples/src/coins/sources.mlb b/examples/src/coins/sources.mlb new file mode 100644 index 000000000..6c4095c72 --- /dev/null +++ b/examples/src/coins/sources.mlb @@ -0,0 +1,2 @@ +../../lib/sources.mlb +coins.sml \ No newline at end of file