Commit 6f01206b authored by batterseapower's avatar batterseapower

Considerable benchmark tweaking

parent 87c35a01
......@@ -28,7 +28,7 @@ SUBDIRS = runstdtest nofib-analyse $(NoFibSubDirs)
#
SRC_DIST_DIR=$(shell pwd)/nofib
SRC_DIST_NAME=nofib
SRC_DIST_DIRS=docs fibon gc imaginary smp spectral real parallel mk
SRC_DIST_DIRS=docs fibon gc imaginary supercompile smp spectral real parallel mk
dist :: nofib-dist-pre
include $(TOP)/mk/target.mk
......
......@@ -7,4 +7,5 @@ FAST_OPTS = 20000
NORM_OPTS = 100000
SLOW_OPTS = 230000
SRC_SUPERCOMP_HC_OPTS =
# Seems to loop with this:
#SRC_SUPERCOMP_HC_OPTS =
TOP = ../..
include $(TOP)/mk/boilerplate.mk
SUBDIRS = SumSquare-LazySum SumSquare
SUBDIRS = SumSquare
# Worthless benchmark, runs too fast:
# SumSquare-LazySum
include $(TOP)/mk/target.mk
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
......@@ -7,4 +7,6 @@ SRCS = Main.hs
FAST_OPTS = 10000000
NORM_OPTS = 10000000
SLOW_OPTS = 10000000
\ No newline at end of file
SLOW_OPTS = 10000000
SRC_SUPERCOMP_HC_OPTS =
......@@ -5,11 +5,11 @@ import System.Environment
main :: IO ()
main = do
[x] <- fmap (map read) getArgs
print (fac x)
print (fac 1 x)
-- Integer arithmetic makes this rather boring, result is usually 0
{-# SUPERCOMPILE fac #-}
fac :: Int -> Int
fac n = case n == 0 of
True -> 1
False -> n * fac (n-1)
fac :: Int -> Int -> Int
fac acc n = case n == 0 of
True -> acc
False -> acc `seq` fac (acc * n) (n-1)
......@@ -7,6 +7,8 @@ SRCS = Main.hs
SRC_RUNTEST_OPTS += +RTS -K32M -RTS
FAST_OPTS = 1000000
NORM_OPTS = 1000000
SLOW_OPTS = 1000000
\ No newline at end of file
FAST_OPTS = 2000000
NORM_OPTS = 2000000
SLOW_OPTS = 2000000
SRC_SUPERCOMP_HC_OPTS =
TOP = ../..
include $(TOP)/mk/boilerplate.mk
SUBDIRS = Append Factorial Raytracer SumTree-NoLiterals SumTree TreeFlip-NoLiterals TreeFlip ZipMaps ZipTreeMaps
SUBDIRS = Append Factorial Raytracer SumTree TreeFlip ZipMaps ZipTreeMaps
include $(TOP)/mk/target.mk
......@@ -2,6 +2,8 @@ module Main where
import System.Environment
import Prelude hiding (sum)
main :: IO ()
main = do
[n] <- fmap (map read) getArgs
......@@ -10,3 +12,11 @@ main = do
{-# SUPERCOMPILE root #-}
root :: [Int] -> [Int] -> Int
root xs ys = sum (zipWith (*) xs ys)
-- Had to copy this out of the libraries because the default sum is a lazy sum:
-- NB: there are no rewrite rules from sum to foldr in the base libraries (probably because the Report version is defined with foldl)
sum :: Num a => [a] -> a
sum l = sum' l 0
where
sum' [] a = a
sum' (x:xs) a = a `seq` sum' xs (a+x)
\ No newline at end of file
......@@ -7,4 +7,6 @@ SRCS = Main.hs
FAST_OPTS = 32000000
NORM_OPTS = 32000000
SLOW_OPTS = 32000000
\ No newline at end of file
SLOW_OPTS = 32000000
SRC_SUPERCOMP_HC_OPTS =
......@@ -7,4 +7,6 @@ SRCS = Main.hs
FAST_OPTS = 22
NORM_OPTS = 22
SLOW_OPTS = 22
\ No newline at end of file
SLOW_OPTS = 22
SRC_SUPERCOMP_HC_OPTS =
......@@ -7,4 +7,6 @@ SRCS = Main.hs
FAST_OPTS = 22
NORM_OPTS = 22
SLOW_OPTS = 22
\ No newline at end of file
SLOW_OPTS = 22
SRC_SUPERCOMP_HC_OPTS =
module Main where
import System.Environment
main :: IO ()
main = print (root [1, 2, 3 :: Int])
main = do
[n] <- fmap (map read) getArgs
print (root [1..n])
{-# SUPERCOMPILE root #-}
root :: [a] -> [(Either a a, Either a a)]
root xs = zip (map (\x -> Left x) xs) (map (\x -> Right x) xs)
root :: [a] -> Int
root xs = length $ zip (map (\x -> Left x) xs) (map (\x -> Right x) xs)
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 32000000
NORM_OPTS = 32000000
SLOW_OPTS = 32000000
SRC_SUPERCOMP_HC_OPTS =
[(Left 1,Right 1),(Left 2,Right 2),(Left 3,Right 3)]
32000000
module Main where
import System.Environment
main :: IO ()
main = print (root (Node (Node Empty (1 :: Int) Empty) 2 (Node Empty 3 Empty)) (Node (Node Empty 4 Empty) 5 (Node Empty 6 Empty)))
main = do
[n] <- fmap (map read) getArgs
--print (root (Node (Node Empty (1 :: Int) Empty) 2 (Node Empty 3 Empty)) (Node (Node Empty 4 Empty) 5 (Node Empty 6 Empty)))
print (root n)
buildTree n t = case n == 0 of
True -> t
False -> buildTree (n-1) (Node t n t)
mapT f xs = case xs of Empty -> Empty
Node l a r -> Node (mapT f l) (f a) (mapT f r)
......@@ -10,9 +19,16 @@ zipT xs ys = case xs of Empty -> Empty
Node l a r -> case ys of Empty -> Empty
Node l' a' r' -> Node (zipT l l') (a, a') (zipT r r')
sizeT :: Tree a -> Int
sizeT Empty = 0
sizeT (Node l _ r) = 1 + sizeT l + sizeT r
{-# SUPERCOMPILE root #-}
root :: Tree a -> Tree b -> Tree (Either a b, Either a b) -- NB: not fully polymorphic
root xt yt = zipT (mapT (\x -> Left x) xt) (mapT (\x -> Right x) yt)
root :: Int -> Int
root n = sizeT (zipMapT (buildTree n Empty) (buildTree n Empty))
zipMapT :: Tree a -> Tree b -> Tree (Either a b, Either a b) -- NB: not fully polymorphic
zipMapT xt yt = zipT (mapT (\x -> Left x) xt) (mapT (\x -> Right x) yt)
data Tree a = Empty | Node (Tree a) a (Tree a)
deriving (Eq, Show)
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 22
NORM_OPTS = 22
SLOW_OPTS = 22
SRC_SUPERCOMP_HC_OPTS =
Node (Node Empty (Left 1,Right 4) Empty) (Left 2,Right 5) (Node Empty (Left 3,Right 6) Empty)
4194303
......@@ -5,6 +5,8 @@ include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 10
NORM_OPTS = 10
SLOW_OPTS = 10
\ No newline at end of file
FAST_OPTS = 500
NORM_OPTS = 500
SLOW_OPTS = 500
SRC_SUPERCOMP_HC_OPTS =
module Main where
import System.Environment
main :: IO ()
main = print (root (+) 0 1 10)
main = do
[n] <- fmap (map read) getArgs
print (length (root (flip (:)) [] 1 n))
-- Example from Section 5 of "Shortcut Fusion for Accumulating Parameters & Zip-like Functions"
-- Optimal output should be isomorphic to:
......
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 32000000
NORM_OPTS = 32000000
SLOW_OPTS = 32000000
SRC_SUPERCOMP_HC_OPTS =
......@@ -3,7 +3,9 @@ module Main where
import System.Environment
main :: IO ()
main = print (root 0)
main = do
[n] <- fmap (map read) getArgs
print (root n)
ack :: Int -> Int -> Int
ack m n = case m of 0 -> n + 1
......
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 10000
NORM_OPTS = 10000
SLOW_OPTS = 10000
SRC_SUPERCOMP_HC_OPTS =
module Main where
import System.Environment
main :: IO ()
main = print (root Z)
main = do
[n] <- fmap (map read) getArgs
print (fromPeano 0 (root (toPeano n)))
toPeano :: Int -> Nat
toPeano 0 = Z
toPeano n = S (toPeano (n - 1))
fromPeano :: Int -> Nat -> Int
fromPeano n Z = n
fromPeano n (S x) = n `seq` fromPeano (1 + n) x
ack m n = case m of S m -> case n of S n -> ack m (ack (S m) n)
Z -> ack m (S Z)
......
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 1000000
NORM_OPTS = 1000000
SLOW_OPTS = 1000000
SRC_SUPERCOMP_HC_OPTS =
module Main where
import System.Environment
main :: IO ()
main = print (root Z)
main = do
[n] <- fmap (map read) getArgs
print (fromPeano 0 (root (toPeano n)))
toPeano :: Int -> Nat
toPeano 0 = Z
toPeano n = S (toPeano (n - 1))
fromPeano :: Int -> Nat -> Int
fromPeano n Z = n
fromPeano n (S x) = n `seq` fromPeano (1 + n) x
ack m n = case m of S m -> case n of S n -> ack m (ack (S m) n)
Z -> ack m (S Z)
......
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 10000
NORM_OPTS = 10000
SLOW_OPTS = 10000
SRC_SUPERCOMP_HC_OPTS =
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
module Main where
import System.Environment
import Prelude hiding (even)
main :: IO ()
main = print (root (S Z))
main = do
[n] <- fmap (map read) getArgs
print (root (toPeano n))
toPeano :: Int -> Nat
toPeano 0 = Z
toPeano n = S (toPeano (n - 1))
double y r = case y of Z -> r
S x -> double x (S (S r))
......
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 2000000
NORM_OPTS = 2000000
SLOW_OPTS = 2000000
SRC_SUPERCOMP_HC_OPTS =
module Main where
import System.Environment
import Prelude hiding (even)
main :: IO ()
main = print (root (S Z))
main = do
[n] <- fmap (map read) getArgs
print (root (toPeano n))
toPeano :: Int -> Nat
toPeano 0 = Z
toPeano n = S (toPeano (n - 1))
double y = case y of Z -> Z
S x -> S (S (double x))
......
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 10000000
NORM_OPTS = 10000000
SLOW_OPTS = 10000000
SRC_SUPERCOMP_HC_OPTS =
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
module Main where
import System.Environment
import Prelude hiding (length)
main :: IO ()
main = print (length "Hello")
main = do
[n] <- fmap (map read) getArgs
print (fromPeano 0 (length [1..n]))
fromPeano :: Int -> Nat -> Int
fromPeano n Z = n
fromPeano n (S x) = n `seq` fromPeano (n + 1) x
foldl' c n xs = case xs of [] -> n; (x:xs) -> let n' = c n x in n' `seq` foldl' c n' xs
{-# SUPERCOMPILE length #-}
......
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 1000000
NORM_OPTS = 1000000
SLOW_OPTS = 1000000
SRC_SUPERCOMP_HC_OPTS =
module Main where
import System.Environment
main :: IO ()
main = print (root [A, A, B, A])
main = do
[n] <- fmap (map read) getArgs
print (root $ replicate n A ++ [A, A, B, A])
alphabetEq x y = case x of
A -> case y of A -> True
......
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 10000000
NORM_OPTS = 10000000
SLOW_OPTS = 10000000
SRC_SUPERCOMP_HC_OPTS =
module Main where
main :: IO ()
main = print (take 4 (fst root), take 4 (snd root))
import System.Environment
example1 = let ones = 1 : ones
in map (\x -> x + 1) ones
import Prelude hiding (sum)
example2 = map (\x -> x + 1) (repeat 1)
main :: IO ()
main = do
[n] <- fmap (map read) getArgs
print (root n)
{-# SUPERCOMPILE root #-}
root = (example1, example2)
root :: Int -> Int
root n = sum (take n example1) + sum (take n example2)
where
example1 = let ones = 1 : ones
in map (\x -> x + 1) ones
example2 = map (\x -> x + 1) (repeat 1)
-- Had to copy this out of the libraries because the default sum is a lazy sum:
-- NB: there are no rewrite rules from sum to foldr in the base libraries (probably because the Report version is defined with foldl)
sum :: Num a => [a] -> a
sum l = sum' l 0
where
sum' [] a = a
sum' (x:xs) a = a `seq` sum' xs (a+x)
\ No newline at end of file
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 10000000
NORM_OPTS = 10000000
SLOW_OPTS = 10000000
SRC_SUPERCOMP_HC_OPTS =
TOP = ../..
include $(TOP)/mk/boilerplate.mk
SUBDIRS = AccumulatingParam-Peano AccumulatingParam Ackermann AckermannPeano-1 AckermannPeano-2 AppendAssociativity AppendRightUnit BlackHole BlackHole2 CoveredCaseBranches EvenDouble EvenDoubleGenerator FloatLetsFromCasesThatReferToUpdate FoldlSpecialisation Generalisation-Lazy Generalisation-Literals-Lazy Generalisation-Literals Generalisation InfiniteMap KMP LetRec LetRecPropagation LetRecUpdateBinding MapMapFusion NaiveReverse NegativeInformation PeterGen PeterGenEasy ReduceRollback ReverseReverse ReverseReverseEqual SimpleLaziness SpecialiseOnFVs Speculation SpeculationTricky SpeculationWorstCase StrictFoldlSpecialisation UncoveredCaseBranches UntypeableAfterSupercompilation ValueDuplication-Case ValueDuplication-Let ValueRecursion
SUBDIRS = AccumulatingParam-Peano AccumulatingParam Ackermann AckermannPeano-1 AckermannPeano-2 EvenDouble EvenDoubleGenerator Generalisation KMP LetRec MapMapFusion ReverseReverse
# Covered by Peter somewhat already:
# AppendAssociativity
# Covered by other benchmarks:
# FoldlSpecialisation Generalisation-Lazy Generalisation-Literals-Lazy (AccumulatingParam-*)
# StrictFoldlSpecialisation (Generalisation)
# Just boring:
# SpeculationWorstCase
# AppendRightUnit
# Generalisation-Literals
include $(TOP)/mk/target.mk
module Main where
import Prelude hiding (map)
import System.Environment
--import Prelude hiding (map)
main :: IO ()
main = print (root [1, 2, 3 :: Int] :: [Either (Either Int Int) Int])
main = do
[n] <- fmap (map read) getArgs
print (root [1..(n :: Int)])
{-
map f xs = case xs of
[] -> []
(x:xs) -> f x : map f xs
-}
{-# SUPERCOMPILE root #-}
root :: [a] -> [Either (Either b a) c]
root xs = map Left (map Right xs)
root :: [a] -> Int
root xs = length (map Left (map Right xs))
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 10000000
NORM_OPTS = 10000000
SLOW_OPTS = 10000000
SRC_SUPERCOMP_HC_OPTS =
[Left (Right 1),Left (Right 2),Left (Right 3)]
10000000
module Main where
import System.Environment
import Prelude hiding (reverse)
main :: IO ()
main = print (root [1, 2, 3])
main = do
[n] <- fmap (map read) getArgs
print (length (root [1..n]))
reverse xs = reverseacc [] xs
where reverseacc ys xs = case xs of [] -> ys; (x:xs) -> reverseacc (x:ys) xs
......
......@@ -4,3 +4,9 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
FAST_OPTS = 1000000
NORM_OPTS = 1000000
SLOW_OPTS = 1000000
SRC_SUPERCOMP_HC_OPTS =
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
......@@ -4,3 +4,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
SRCS = Main.hs
SRC_SUPERCOMP_HC_OPTS =
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment