fannkuch-redux Haskell GHC #4 program

{-  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:
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