The Computer Language
22.01 Benchmarks Game

reverse-complement Haskell GHC #2 program

source code

--
-- The Computer Language Benchmarks Game
-- https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
--
-- Contributed by Sterling Clover
-- Heavily inspired by contribution from Don Stewart
-- Inlining improvements by Don Stewart.
-- GHC 7.8.1 fix by Ersin Er
-- GHC 9.0.1 fix by Artem Pelenitsyn
--

import qualified Data.ByteString.Char8 as S
import Data.ByteString.Internal
import Data.ByteString.Unsafe
import Foreign
import Control.Arrow
import GHC.Base
import GHC.Ptr
import GHC.IO

main = uncurry proc =<< clines `fmap` S.getContents

proc [] _ = return ()
proc (h:hs) (b:bs) = S.putStrLn h >> revcomp b >> writeFasta b >> proc hs bs

writeFasta t
    | S.null t  = return ()
    | otherwise = S.putStrLn l >> writeFasta r
    where (l,r) = S.splitAt 60 t

clines :: ByteString -> ([ByteString],[ByteString])
clines ps = clines' ps ([],[])
    where
      {-# INLINE clines' #-}
      clines' ps accum@(f,s)
          | otherwise = case S.elemIndex '\n' ps of
                          Just n  -> clines'' (S.drop (n+1) ps) (f++[S.take n ps],s)
      clines'' ps accum@(f,s)
          | otherwise = case S.elemIndex '>' ps of
                      Nothing -> (f,s++[S.filter (/='\n') ps])
                      Just n  -> clines' (S.drop n ps) (f,s++[S.filter (/='\n') . S.take n $ ps])

{-# INLINE comps #-}
comps = map (ord *** c2w) [
    ('A' , 'T'), ( 'a' , 'T'), ( 'C' , 'G'), ( 'c' , 'G'), ( 'G' , 'C'),
    ('g' , 'C'), ( 'T' , 'A'), ( 't' , 'A'), ( 'U' , 'A'), ( 'u' , 'A'),
    ('M' , 'K'), ( 'm' , 'K'), ( 'R' , 'Y'), ( 'r' , 'Y'), ( 'Y' , 'R'),
    ('y' , 'R'), ( 'K' , 'M'), ( 'k' , 'M'), ( 'V' , 'B'), ( 'v' , 'B'),
    ('H' , 'D'), ( 'h' , 'D'), ( 'D' , 'H'), ( 'd' , 'H'), ( 'B' , 'V'), ( 'b' , 'V')]

ca :: Ptr Word8
ca = unsafeDupablePerformIO $ do
       a <- mallocArray 200
       mapM_ (uncurry (pokeByteOff a)) $ zip [0..199::Int] [0..199::Word8]
       mapM_ (uncurry (pokeByteOff a)) comps
       return a

comp :: Word# -> Word#
comp c = rw8 ca (word2Int# c)

revcomp (PS fp s (I# l)) = withForeignPtr fp $ \p -> rc (p `plusPtr` s) 0# (l -# 1#)
  where
    rc :: Ptr Word8 -> Int# -> Int# -> IO ()
    rc p i j  = rc' i j
        where
          rc' i j
              | isTrue# (i <# j) = do
                          let x = rw8 p i
                          ww8 p i (comp (rw8 p j))
                          ww8 p j (comp x)
                          rc' (i +# 1#) (j -# 1#)
              | isTrue# (i ==# j) = ww8 p i (comp (rw8 p i))
              | otherwise =  return ()

rw8 :: Ptr Word8 -> Int# -> Word#
rw8 (Ptr a) i = case readWord8OffAddr# a i realWorld#  of (# _, x #) ->  x
{-# INLINE rw8 #-}

ww8 :: Ptr Word8 -> Int# -> Word# -> IO ()
ww8 (Ptr a) i x  = IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #)
    

notes, command-line, and program output

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


Thu, 13 Jan 2022 00:07:08 GMT

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

revcomp.ghc-2.hs:76:74: error:
    • Couldn't match expected type ‘Word#’ with actual type ‘Word8#’
    • In the expression: x
      In a case alternative: (# _, x #) -> x
      In the expression:
        case readWord8OffAddr# a i realWorld# of (# _, x #) -> x
   |
76 | rw8 (Ptr a) i = case readWord8OffAddr# a i realWorld#  of (# _, x #) ->  x
   |                                                                          ^

revcomp.ghc-2.hs:80:59: error:
    • Couldn't match expected type ‘Word8#’ with actual type ‘Word#’
    • In the third argument of ‘writeWord8OffAddr#’, namely ‘x’
      In the expression: writeWord8OffAddr# a i x s
      In the expression:
        case writeWord8OffAddr# a i x s of s2 -> (# s2, () #)
   |
80 | ww8 (Ptr a) i x  = IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #)
   |                                                           ^
make: [/home/dunham/all-benchmarksgame/2000-benchmarksgame/nanobench/makefiles/u64q.programs.Makefile:243: revcomp.ghc-2.ghc_run] Error 1 (ignored)
rm revcomp.ghc-2.hs

5.04s to complete and log all make actions

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

MAKE ERROR