The Computer Language
24.04 Benchmarks Game

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.4.8
LLVM version 17.0.2


 Thu, 07 Mar 2024 23:11:34 GMT

MAKE:
mv fannkuchredux.ghc fannkuchredux.hs
~/.ghcup/bin/ghc --make -optlo-passes='module(default<O2>)' -O2 -fno-llvm-tbaa -XBangPatterns -threaded -rtsopts -XScopedTypeVariables fannkuchredux.hs -o fannkuchredux.ghc_run
Loaded package environment from /home/dunham/.ghc/x86_64-linux-9.4.8/environments/default
[1 of 2] Compiling Main             ( fannkuchredux.hs, fannkuchredux.o )

fannkuchredux.hs:17:1: warning: [-Wtabs]
    Tab character found here, and in six further locations.
    Suggested fix: Please use spaces instead.
   |
17 |         (t, r) = flop' h (lst, t)
   | ^^^^^^^^
[2 of 2] Linking fannkuchredux.ghc_run
rm fannkuchredux.hs

10.99s to complete and log all make actions

COMMAND LINE:
 ./fannkuchredux.ghc_run +RTS -N4 -RTS 12

PROGRAM OUTPUT:
3968050
Pfannkuchen(12) = 65