Ganar con veinte líneas de Haskell: escribir tu WC

Hola Habr

El otro día SiemarglMe invitó a traducir un curioso artículo sobre la victoria sobre Unix wccon la ayuda de Haskell. Por supuesto, no lo traduciré, y por varias razones:

• el autor exprimió lejos de todo, desde la versión de un solo hilo, y la versión de un solo hilo fue mucho más lenta wc,
• en ese artículo, era necesario usar multihilo para ganar (lo que en sí mismo es un poco de trampa y victoria en lugar del sentido común en lugar de hacerlo wc),
• para esto, el autor tuvo que profundizar en trichomónadas y monoides: no, esta es una excelente ilustración de los encantos del pensamiento monoidal, pero en mi humilde opinión, es demasiado para tal tarea, especialmente porque debido a esto
• el código resultó ser demasiado voluminoso
• y de hecho, para competir wc, que tiene un montón de opciones y características, darse cuenta de que es un análogo de juguete, en general es de alguna manera extraño e incluso un poco tonto.

Sin embargo, hacer cosas extrañas es algo bueno, por lo que hoy intentaremos arreglar el primero de los puntos anteriores y mejorar el resultado de Chris (el nombre del autor del artículo original).

Nuevamente, como descubrimos la última vez, no puedo escribir el código C, así que tampoco lo escribiré, y como competidor de la implementación de Haskell, yo (como Chris) tengo un wcsistema GNU Coreutils. Esos tipos ciertamente saben cómo escribir en C, este código no tiene una década de antigüedad y se encargaron del rendimiento, a juzgar por tales piezas:

/* 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: adelantaremos el sistema uno por wcun orden de magnitud sin ningún problema, obteniendo un código completamente idiomático y gastando menos de media hora en cambiar y optimizar el código original.

Condiciones del experimento

Entonces, primero discutimos la configuración experimental.

Datos

Descargué este archivo y lo pegué conmigo, por lo que el tamaño total es de aproximadamente 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 , , . , .

Bueno, para no atormentar, discutiremos los planes para el futuro: en el próximo artículo trataremos algo sustancialmente más interesante, donde el Haskell realmente brillará. Más específicamente, modularizamos lo que tenemos hoy, vemos cómo hacer que nuestro juguete sea un haskell wcpoco menos juguete y también evaluamos cómo esto afectará el rendimiento.