Menang Bersama Twenty Haskell Lines: Writing Your Wc

Halo Habr.

Hari yang lain Siemarglmengundang saya untuk menerjemahkan artikel yang ingin tahu tentang kemenangan atas Unix wcdengan bantuan Haskell. Tentu saja, saya tidak akan menerjemahkannya, dan karena beberapa alasan:

• penulis diperas keluar dari versi single-threaded bukan berarti segalanya, dan versi single-threaded jauh lebih lambat wc,
• dalam artikel itu, perlu menggunakan multithreading untuk menang (yang dengan sendirinya sedikit curang dan kemenangan lebih dari akal sehat daripada berakhir wc),
• untuk ini, penulis harus menyelidiki trichomonad dan monoids - bukan, ini adalah ilustrasi yang sangat baik dari pesona pemikiran monoid, tetapi IMHO terlalu banyak untuk tugas seperti itu, terutama karena karena ini
• kode itu ternyata terlalu banyak,
• dan memang, untuk bersaing dengan wc, yang memiliki banyak pilihan dan fitur, menyadari itu adalah analog yang sangat mainan, secara umum itu entah bagaimana aneh dan bahkan sedikit konyol.

Meskipun demikian, melakukan hal-hal aneh adalah hal yang baik, jadi hari ini kami akan mencoba memperbaiki yang pertama dari poin-poin di atas dan meningkatkan hasil dari Chris (nama penulis artikel asli).

Sekali lagi, ketika kami mengetahui terakhir kali, saya tidak dapat menulis kode C, jadi saya juga tidak akan menulisnya, dan sebagai pesaing untuk implementasi Haskell, saya (seperti Chris) memiliki sistem wcGNU Coreutils. Orang-orang itu pasti tahu cara menulis dalam bahasa C, kode ini belum berumur satu dekade, dan mereka memperhatikan kinerjanya, dilihat dari bagian-bagian berikut:

/* If the average line length in the block is >= 15, then use
   memchr for the next block, where system specific optimizations
   may outweigh function call overhead.
   FIXME: This line length was determined in 2015, on both
   x86_64 and ppc64, but it's worth re-evaluating in future with
   newer compilers, CPUs, or memchr() implementations etc.  */

Spoiler: kami akan mengambil alih sistem satu per satu dengan wcurutan besarnya tanpa masalah, mendapatkan kode yang sepenuhnya idiomatis dan menghabiskan kurang dari setengah jam untuk mengubah dan mengoptimalkan kode asli.

Kondisi Eksperimen

Jadi, pertama kita bahas pengaturan eksperimental.

Data

Saya mengunduh file ini dan menyimpannya bersama saya, sehingga ukuran totalnya sekitar 1,8 gigabytes:

% for i in `seq 1 10`; cat part.txt >> test.txt
% du -sh test.txt
1.8G    test.txt

, test.txt tmpfs-, , IO.

Gentoo Linux Core i7 4770 32 .

- ghc 8.8.2.

wc coreutils 8.31, gcc 9.2 -O2 -march=native:

% wc --version
wc (GNU coreutils) 8.31
Packaged by Gentoo (8.31-r1 (p0))

, -march=native — C, - - , : x86_64-, wc coreutils ( SIMD-, ).

, -O3 -O2 — , -O2.

, time. time , , ,

1. 0.3 ,
2. , , .

, ( ) , .

? wc!

Unicode ( ), C-, wc LANG=C LC_ALL=C wc /path/to/test.txt. ? 10.4 . .

, (ru_RU.UTF-8) wc (7.20 ), , , , C- — , .

, ( ), 0.2 — , IO-bound-.

Haskell

, ?

, cs bs ( , ):

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Char

wc :: BS.ByteString -> (Int, Int, Int)
wc s =
    let (bs, ws, ls, _) = BS.foldl' go (0, 0, 0, False) s
     in (bs, ws, ls)
  where
    go :: (Int, Int, Int, Bool) -> Char -> (Int, Int, Int, Bool)
    go (!bs, !ws, !ls, !wasSpace) c =
        let addLine | c == '\n' = 1
                    | otherwise = 0
            addWord | wasSpace = 0
                    | isSpace c = 1
                    | otherwise = 0
         in (bs + 1, ws + addWord, ls + addLine, isSpace c)

, , ( ).

, , 9 wc. : 31.2 , 306% wc. 9 , , .

, ( , ), , , , .

?

-, , — . :

{-# LANGUAGE Strict #-}
{-# LANGUAGE RecordWildCards #-}

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Char

data State = State
  { bs :: Int
  , ws :: Int
  , ls :: Int
  , wasSpace :: Bool
  }

wc :: BS.ByteString -> (Int, Int, Int)
wc s = (bs, ws, ls)
  where
    State { .. } = BS.foldl' go (State 0 0 0 False) s

    go State { .. } c = State (bs + 1) (ws + addWord) (ls + addLine) (isSpace c)
      where
        addLine | c == '\n' = 1
                | otherwise = 0
        addWord | wasSpace = 0
                | isSpace c = 1
                | otherwise = 0

bang-, - {-# LANGUAGE Strict #-}. , ?

, , — 4 ! 7.56 , 75% wc, ! ?

, : , , . -

data State = State
  { bs :: {-# UNPACK #-} !Int
  , ws :: {-# UNPACK #-} !Int
  , ls :: {-# UNPACK #-} !Int
  , wasSpace :: !Bool
  }

Int- . , nursery area, , , — , .

CSE

, isSpace c , — . , , go :

    go State { .. } c = State (bs + 1) (ws + addWord) (ls + addLine) isSp
      where
        isSp = isSpace c
        addLine | c == '\n' = 1
                | otherwise = 0
        addWord | wasSpace = 0
                | isSp = 1
                | otherwise = 0

? — 2.93 , 28% wc.

? ghc , , ? — isSpace ( ) , common subexpression elimination.

— ( ). , wc , . - , :

1. LLVM- ( -fllvm) — , .
2. ( -O2) — -O , -O2 , ?
3. ( {-# INLINE wc #-}). , - , , , - . , , , .

, , , .

:

. -, . , -O2 , , LLVM- , ( ).

, . , C (19%!). , .

.

, State, .

, Bool , . , Int, 1 True, 0 — False? , , !

data State = State
  { bs :: Int
  , ws :: Int
  , ls :: Int
  , wasSpace :: Int
  }

wc :: BS.ByteString -> (Int, Int, Int)
wc s = (bs, ws, ls)
  where
    State { .. } = BS.foldl' go (State 0 0 0 0) s

    go State { .. } c = State (bs + 1) (ws + addWord) (ls + addLine) isSp
      where
        isSp | isSpace c = 1
             | otherwise = 0
        addLine | c == '\n' = 1
                | otherwise = 0
        addWord | wasSpace == 1 = 0
                | isSp == 1 = 1
                | otherwise = 0

(, Bool), . , , addWord guard' ( if) :

        addWord = (1 - wasSpace) * isSp

.

? , , 1.91 , 18% wc. , .

, ?

ASCII, isSpace. , . , , , .

, Data.ByteString.Lazy Data.ByteString.Lazy.Char8, Char.

:

{-# LANGUAGE Strict #-}
{-# LANGUAGE RecordWildCards #-}

module Data.WordCount where

import qualified Data.ByteString.Lazy as BS

data State = State
  { bs :: Int
  , ws :: Int
  , ls :: Int
  , wasSpace :: Int
  }

wc :: BS.ByteString -> (Int, Int, Int)
wc s = (bs, ws, ls)
  where
    State { .. } = BS.foldl' go (State 0 0 0 0) s

    go State { .. } c = State (bs + 1) (ws + addWord) (ls + addLine) isSp
      where
        isSp | c == 32 || c - 9 <= 4 = 1
             | otherwise = 0
        addLine | c == 10 = 1
                | otherwise = 0
        addWord = (1 - wasSpace) * isSp
{-# INLINE wc #-}

, 1.45 , 14% wc.

, — , , .

, , . , : wasSpace , , :

wc s = (bs, ws + 1 - wasSpace, ls)
  where
    State { .. } = BS.foldl' go (State 0 0 0 1) s
    ...

, .

:

0.35 , ? - - ?

, , wc. :

main :: IO ()
main = do
  [path] <- getArgs
  contents <- BS.readFile path
  print $ wc contents

readFile . mmap. bytestring-mmap, ByteString' mmap- , main

main :: IO ()
main = do
  [path] <- getArgs
  contents <- unsafeMMapFile path
  print $ wc contents

, unsafeMMapFile ByteString, wc, . , unsafeMMapFile, , mmap- , .

— , 0.04-0.06 0.35 . , .

mmap , : , , . , : , .

?

, , Unix-, . , , ST .

, , : , wc, , « » wc , , . , .

Nah, agar tidak menyiksa, kita akan membahas rencana untuk masa depan: di artikel selanjutnya kita akan membahas sesuatu yang jauh lebih menarik, di mana Haskell akan benar-benar bersinar. Lebih khusus, kami memodulasi apa yang kami miliki saat ini, melihat bagaimana membuat mainan kami haskell wclebih sedikit, dan juga mengevaluasi bagaimana ini akan mempengaruhi kinerja.