fannkuch-redux Haskell GHC program
source code
{- The Computer Language Benchmarks Game
https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
contributed by Miha Vučkovič
-}
import System.Environment
import Control.Applicative
flop (2:x1:t) = x1:2:t
flop (3:x1:x2:t) = x2:x1:3:t
flop (4:x1:x2:x3:t) = x3:x2:x1:4:t
flop (5:x1:x2:x3:x4:t) = x4:x3:x2:x1:5:t
flop (6:x1:x2:x3:x4:x5:t) = x5:x4:x3:x2:x1:6:t
flop (7:x1:x2:x3:x4:x5:x6:t) = x6:x5:x4:x3:x2:x1:7:t
flop lst@(h:_) = r where
(t, r) = flop' h (lst, t)
flop' 0 (t, r) = (t, r)
flop' n ((h:t), r) = flop' (n-1) (t, h:r)
flopS (1:_) = 0
flopS lst = 1 + flopS (flop lst)
rotate n (h:t) = rotate' (n-1) t where
rotate' 0 l = h:l
rotate' n (f:t) = f:(rotate' (n-1) t)
checksum i f
| mod i 2 == 0 = f
| True = -f
pfold r [] = r
pfold (ac, af) ((c, f):t) = seq sc $ seq sf $ pfold (sc, sf) t where
sc = ac+c
sf = max af f
permut n = foldr perm [[1..n]] [2..n] where
perm x lst = concat [take x $ iterate (rotate x) l | l <- lst]
main = do
n <- read.head <$> getArgs
let (chksm, mflops) = pfold (0,0) $ map (\(i, p) -> let flops = flopS p in (checksum i flops, flops)) $ zip [0..] (permut n)
putStrLn $ (show chksm) ++ "\nPfannkuchen(" ++ (show n) ++ ") = " ++ (show $ mflops)
notes, command-line, and program output
NOTES:
64-bit Ubuntu quad core
The Glorious Glasgow Haskell
Compilation System,
version 9.10.1
LLVM version 18.1.3
Thu, 01 Aug 2024 18:59:42 GMT
MAKE:
mv fannkuchredux.ghc fannkuchredux.hs
~/.ghcup/bin/ghc --make -fllvm -O2 -XBangPatterns -threaded -rtsopts -XScopedTypeVariables fannkuchredux.hs -o fannkuchredux.ghc_run
Loaded package environment from /home/dunham/.ghc/x86_64-linux-9.10.1/environments/default
[1 of 2] Compiling Main ( fannkuchredux.hs, fannkuchredux.o )
fannkuchredux.hs:17:1: warning: [GHC-94817] [-Wtabs]
Tab character found here, and in six further locations.
Suggested fix: Please use spaces instead.
|
17 | (t, r) = flop' h (lst, t)
| ^^^^^^^^
fannkuchredux.hs:41:14: warning: [GHC-63394] [-Wx-partial]
In the use of ‘head’
(imported from Prelude, but defined in GHC.Internal.List):
"This is a partial function, it throws an error on empty lists. Use pattern matching, 'Data.List.uncons' or 'Data.Maybe.listToMaybe' instead. Consider refactoring to use "Data.List.NonEmpty"."
|
41 | n <- read.head <$> getArgs
| ^^^^
[2 of 2] Linking fannkuchredux.ghc_run
rm fannkuchredux.hs
17.84s to complete and log all make actions
COMMAND LINE:
./fannkuchredux.ghc_run +RTS -N4 -RTS 12
PROGRAM OUTPUT:
3968050
Pfannkuchen(12) = 65