fannkuch-redux Haskell GHC #4 program
source code
{- The Computer Language Benchmarks Game
https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
contributed by Branimir Maksimovic
optimized/rewritten by Bryan O'Sullivan
modified by Gabriel Gonzalez
-}
import System.Environment
import Text.Printf
import Data.Bits
import qualified Data.Vector.Unboxed.Mutable as VM
import qualified Data.Vector.Generic.Mutable as VG
import qualified Data.Vector.Unboxed as V
main = do
n <- getArgs >>= readIO.head
(checksum,maxflips) <- fannkuch n
printf "%d\nPfannkuchen(%d) = %d\n" checksum n maxflips
fannkuch :: Int -> IO (Int, Int)
fannkuch n = do
perm <- V.unsafeThaw $ V.enumFromN 1 n
!tperm <- VG.new n
!cnt <- VG.replicate n 0
let
loop :: Int -> Int -> Int -> IO(Int,Int)
loop !c !m !pc = do
b <- next_permutation perm n cnt
if b == False
then return (c,m)
else do
VM.unsafeCopy tperm perm
let count_flips !flips = {-# SCC "count_flips" #-} do
f <- VM.unsafeRead tperm 0
if f == 1
then loop (c + (if pc .&. 1 == 0 then flips else -flips))
(max m flips)
(pc+1)
else do
VG.reverse $ VM.unsafeSlice 0 f tperm
count_flips (flips+1)
count_flips 0
loop 0 0 1
next_permutation :: VM.IOVector Int -> Int -> VM.IOVector Int -> IO Bool
next_permutation perm !n !cnt = loop 1
where
loop :: Int -> IO Bool
loop i
| i >= n = done i
| otherwise = do
tmp <- VM.unsafeRead perm 0
let
rotate :: Int -> IO()
rotate j
| j >= i = VM.unsafeWrite perm i tmp
| otherwise = do
!v <- VM.unsafeRead perm (j+1)
VM.unsafeWrite perm j v
rotate (j+1)
rotate 0
v <- VM.unsafeRead cnt i
if v >= i
then VM.unsafeWrite cnt i 0 >> loop (i+1)
else done i
done :: Int -> IO Bool
done i
| i >= n = return False
| otherwise = do
v <- VM.unsafeRead cnt i
VM.unsafeWrite cnt i (v+1)
return True
notes, command-line, and program output
NOTES:
64-bit Ubuntu quad core
The Glorious Glasgow Haskell Compilation System,
version 8.8.1
Tue, 05 May 2020 22:12:31 GMT
MAKE:
mv fannkuchredux.ghc-4.ghc fannkuchredux.ghc-4.hs
/opt/src/ghc-8.8.1/bin/ghc --make -fllvm -O2 -XBangPatterns -threaded -rtsopts -XScopedTypeVariables fannkuchredux.ghc-4.hs -o fannkuchredux.ghc-4.ghc_run
Loaded package environment from /home/dunham/.ghc/x86_64-linux-8.8.1/environments/default
[1 of 1] Compiling Main ( fannkuchredux.ghc-4.hs, fannkuchredux.ghc-4.o )
You are using an unsupported version of LLVM!
Currently only 7 is supported.
We will try though...
Linking fannkuchredux.ghc-4.ghc_run ...
rm fannkuchredux.ghc-4.hs
24.05s to complete and log all make actions
COMMAND LINE:
./fannkuchredux.ghc-4.ghc_run +RTS -N4 -RTS 12
PROGRAM OUTPUT:
3968050
Pfannkuchen(12) = 65