The Computer Language
Benchmarks Game

reverse-complement Haskell GHC #3 program

source code

{-
The Computer Language Benchmarks Game
https://salsa.debian.org/benchmarksgame-team/benchmarksgame/

contributed by Louis Wasserman
-}

import Control.Monad
import Foreign
import Data.ByteString.Internal
import System.IO

data Buf = Buf !Int !Int !(Ptr Word8) 

withBuf run = run . Buf 0 ini =<< mallocBytes ini
  where ini = 1024

newSize len sz
  | len <= sz  = sz
  | otherwise  = newSize len (2 * sz)

{-# INLINE putBuf #-}
putBuf pS lS (Buf lD szD pD) run
  | lD' > szD  = do
    let szD' = newSize lD' szD
    pD' <- reallocBytes pD szD'
    copyArray (pD' +* lD) pS lS
    run (Buf lD' szD' pD')
  | otherwise  = do
    copyArray (pD +* lD) pS lS
    run (Buf lD' szD pD)
  where lD' = lD + lS

findChar p n c zero one = do
    q <- memchr p c (fromIntegral (n :: Int))
    if q == nullPtr then zero else one $! q `minusPtr` p

clearBuf (Buf _ lB pB) = Buf 0 lB pB

main = allocaArray 82 $ \ line ->
  let go !buf = do
      !m <- hGetBuf stdin line 82
      if m == 0 then revcomp buf else do
        findChar line m (c2w '>') 
          (putBuf line m buf go)
          (\ end -> do
            putBuf line end buf revcomp
            putBuf (line +* end) (m - end) (clearBuf buf)
              go)
    in withBuf go

(+*) = advancePtr

{-# INLINE comps #-}
comps = Prelude.zipWith (\ a b -> (fromEnum a, c2w b)) "AaCcGgTtUuMmRrYyKkVvHhDdBb" 
  "TTGGCCAAAAKKYYRRMMBBDDHHVV"

ca :: Ptr Word8
ca = inlinePerformIO $ do
       !a <- mallocArray 200
       mapM_ (\ i -> pokeByteOff a (fromIntegral i) i ) [0..199::Word8]
       mapM_ (uncurry (pokeByteOff a)) comps
       return a

revcomp (Buf lBuf _ pBuf) = when (lBuf > 0) $ ca `seq`
  findChar pBuf lBuf (c2w '\n') undefined $ \ begin -> let
    begin' = begin + 1
    rc :: Ptr Word8 -> Ptr Word8 -> IO ()
    rc !i !j | i < j = do
      x <- peek i
      if x == c2w '\n' then let !i' = i +* 1 in rc1 j i' =<< peek i'
        else rc1 j i x
    rc i j = when (i == j) (poke i =<< comp =<< peek i)
    
    rc1 !j !i !xi = do
      y <- peek j
      if y == c2w '\n' then let !j' = j +* (-1) in rc2 i xi j' =<< peek j'
        else rc2 i xi j y
    
    comp = peekElemOff ca . fromIntegral
    
    rc2 !i !xi !j !xj = do
      poke j =<< comp xi
      poke i =<< comp xj
      rc (i +* 1) (j +* (-1))
    in do
      hPutBuf stdout pBuf begin'
      rc (pBuf +* begin') (pBuf +* (lBuf - 1))
      hPutBuf stdout (pBuf +* begin') (lBuf - begin - 1)
    

notes, command-line, and program output

NOTES:
64-bit Ubuntu quad core
The Glorious Glasgow Haskell Compilation System,
version 9.0.1


Sun, 21 Feb 2021 00:38:00 GMT

MAKE:
mv revcomp.ghc-3.ghc revcomp.ghc-3.hs
/opt/src/ghc-9.0.1/bin/ghc --make -fllvm -O2 -XBangPatterns -threaded -rtsopts -funfolding-use-threshold=32 -XMagicHash -XUnboxedTuples revcomp.ghc-3.hs -o revcomp.ghc-3.ghc_run
[1 of 1] Compiling Main             ( revcomp.ghc-3.hs, revcomp.ghc-3.o )

revcomp.ghc-3.hs:59:6: error:
    Variable not in scope: inlinePerformIO :: IO (Ptr b0) -> Ptr Word8
   |
59 | ca = inlinePerformIO $ do
   |      ^^^^^^^^^^^^^^^
make: [/home/dunham/all-benchmarksgame/2000-benchmarksgame/nanobench/makefiles/u64q.programs.Makefile:243: revcomp.ghc-3.ghc_run] Error 1 (ignored)
rm revcomp.ghc-3.hs

5.08s to complete and log all make actions

COMMAND LINE:
./revcomp.ghc-3.ghc_run +RTS -N4 -RTS 0 < revcomp-input250000.txt

MAKE ERROR