Радости и горести побед над C: делаем конфетку из прототипа wc на хаскеле

    Привет, Хабр.


    Итак, в прошлый раз мы эмпирически доказали, что на хаскеле можно довольно легко написать этакий игрушечный wc, который при этом существенно быстрее реализации wc из GNU Coreutils. Понятное дело, что это не совсем честное сравнение: наша программа не умеет ничего, кроме подсчёта байт, строк и слов, тогда как настоящий wc куда мощнее: он имеет ещё несколько статистик, поддерживает опции, умеет читать из stdin… Короче, у нас действительно получилась всего лишь игрушка.


    Сегодня мы это исправим. Наша главная цель — позволить пользователю выбирать конкретные статистики для подсчёта, при этом не считая то, что пользователю не нужно. А самое главное — мы будем стремиться к модульности, выделяя каждую статистику в отдельный изолированный юнит.


    Действительно, если мы посмотрим на C-версию — ну, лично я бы не назвал это образцом читаемого и поддерживаемого кода, так как там всё происходит в одной большой функции на 370 строк. Мы будем стараться этого избежать.



    Основная функция С-версии не влезла на 4k-экран в портретной ориентации 4-м шрифтом.


    Кроме этой модуляризации мы, среди прочего:


    • выразим идею, что некоторые статистики вроде подсчёта числа байт могут работать эффективнее на всём входе целиком, а другие должны смотреть на каждый байт;
    • реализуем ещё больше статистик, наслаждаясь возможностью рассуждать о каждой из них в отдельности (то, что называют local reasoning);
    • напишем немного тестов, наслаждаясь local reasoning'ом ещё раз;
    • испытаем некоторые почти зависимо типизированные техники, успешно получив корректно работающий, но феерически тормозящий код;
    • поиграем с Template Haskell;
    • полюбуемся (не)предсказуемостью и (не)воспроизводимостью производительности результирующего кода.

    На всякий случай вспомним, чем мы закончили предыдущий пост:


    {-# 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 + 1 - wasSpace, ls)
      where
        State { .. } = BS.foldl' go (State 0 0 0 1) 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 #-}

    Мы хотим разбить эту функцию на отдельные кусочки, считающие соответственно количество байт, слов и строк. Как этого можно добиться?


    Композабельные левые свёртки


    В первую очередь заметим, что основная часть нашего алгоритма выражается как свёртка. В самом деле, об этом говорит даже название функции BS.foldl'!


    Некоторое время назад я наткнулся на библиотеку foldl, предназначенную для «композабельных, потоковых и эффективных левых свёрток». Это ровно то, что нам нужно! Более того, к счастью, в этой библиотеке даже есть отдельный модуль для свёрток по ByteString. В частности, в этом модуле есть две из трёх нужных нам статистик: количество байт равно длине входной строки (то есть, length в этом модуле), а количество строк можно посчитать при помощи функции count (через count 10). Похоже, осталось реализовать свёртку для подсчёта слов, и мы в дамках!


    Для того, чтобы реализовать эту свёртку, можно взять нашу исходную функцию и просто выкинуть из неё всё лишнее. Вот так в итоге выглядит результат:


    {-# LANGUAGE Strict #-}
    
    import qualified Control.Foldl as L
    import qualified Data.ByteString as BS
    
    data WordState = WordState { ws :: Int, wasSpace :: Int }
    
    wordsCount :: L.Fold BS.ByteString Int
    wordsCount = L.Fold (BS.foldl' go) (WordState 0 1) (\WordState { .. } -> ws + 1 - wasSpace)
      where
        go WordState { .. } c = WordState (ws + addWord) isSp
          where
            isSp | c == 32 || c - 9 <= 4 = 1
                 | otherwise = 0
            addWord = (1 - wasSpace) * isSp

    Тогда посчитать байты, строки и слова одновременно можно так:


    import qualified Control.Foldl.ByteString as BL
    import qualified Data.ByteString.Lazy as BSL
    
    main :: IO ()
    main = do
      [path] <- getArgs
      contents <- unsafeMMapFile path
      let res = BL.fold ((,,) <$> BL.length <*> BL.count 10 <*> wordsCount) (BSL.fromStrict contents) :: (Int, Int, Int)
      print res

    Композабельно! Но насколько эффективно?


    Если бенчмаркать так же, как описано в предыдущем посте (запуская пять раз на 1.8-гигабайтовом файле, находящемся в tmpfs-разделе для устранения IO, и выбирая наилучший результат), то на моей машине получится в районе 2.5 секунд. Кстати, надо для честности отметить, что это машина с другим процессором, чем использованная в прошлом посте (хотя скорость работы что оригинального wc, что результата усилий из прошлого поста на ней отличается несущественно), да и ней есть куча источников шума вроде запущенного браузера или IDE, но для составления общей картины о характеристиках кода и иллюстрации идеи поста этого хватит.


    Итак, 2.5 секунд. Почти вдвое хуже, чем было раньше.


    Что, если мы посчитаем только лишь длину и количество слов?


      let res = BL.fold ((,) <$> BL.length <*> wordsCount) contents :: (Int, Int)
      print res

    1.55 секунд. Хмм. Что насчёт количества строк?


      let res = BL.fold (BL.count 10) contents :: Int
      print res

    1.05 секунд.


    Чёрт. Оно практически аддитивно. Но оно не должно быть аддитивно! Например, подсчёт количества строк (сводящийся к подсчёту количества '\n') должен затмеваться куда более сложной логикой подсчёта количества слов, но мы этого не наблюдаем.


    Плохо. Чтобы понять, что происходит, засучим рукава и залезем в кишки библиотеки foldl.


    foldl реализован следующим образом. Он берёт каждый чанк входа и скармливает его каждой из свёрток в композиции. В случае строк foldl бегает по ленивым ByteString'ам, которые примерно изоморфны списку строгих ByteString'ов, каждая из которых и является чанком. В данном конкретном случае размер чанка — 256 килобайт, что не влезает в L1-кэш, так что мы вынуждены платить за перемещение данных из L2 в L1 (и даже за перемещение из L1 в регистры).


    Мы, конечно, могли бы уменьшить размер чанка до 16-32 килобайт, чтобы он помещался в L1, но это не так интересно.


    И, что гораздо хуже, компилятор, похоже, не может оптимизировать лишние вычисления: время работы BL.fold ((,) <$> wordsCount <*> wordsCount) contents (то есть, двойного подсчёта слов) вдвое больше времени BL.fold wordsCount contents. Так что от этого подхода мы вынуждены отказаться.


    Кроме того, неочевидно, как совмещать свёртки «по запросу», например, на основании опций командной строки.


    Так что давайте напишем...


    Наши собственные свёртки


    Перед тем, как бросаться к редактору кода, давайте немного подумаем о дизайне. В итоге мы хотим строить композиции свёрток на основе рантайм-выбора пользователя. Как это может выглядеть?


    Пусть у нас есть какие-то базовые «атомарные» свёртки (то есть, статистики) f1, f2, f3, и пользователю нужна композиция f1 и f3. Думаю, даже компиляторы функциональных языков ещё долго будут не настолько умны, чтобы понять, что код вроде


      -- options — список булевых значений, соответствующих атомарным свёрткам
      options <- parseCliOptions
    
      -- theFold — результирующая композиция
      let theFold = foldl' f (zip options [f1, f2, f3]) emptyFold
      where
        f acc (True, stat) = acc `compose` stat
        f acc (False, _) = acc

    означает, что необходимо специализировать все возможные композиции свёрток, которые тут могут возникнуть.


    Единственный способ быть уверенным, что у компилятора достаточно информации — поднять всё это на уровень типов. Хаскель в итоге избавляется от типов на этапе компиляции, так что любая информация, выраженная через типы, оказывается доступна компилятору.


    Типы на помощь


    Так как нам представить свёртку?


    Один дружественный к типам способ — через тайпкласс. Только перед тем, как обсуждать тайпклассы, давайте сразу упомянем необходимые в дальнейшем расширения системы типов, чтобы потом на них не отвлекаться:


    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances #-}
    {-# LANGUAGE TypeFamilyDependencies, FunctionalDependencies, PolyKinds, DataKinds, GADTs, TypeOperators #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    Что на самом деле является свёрткой-статистикой в нашем случае? Статистика состоит из:


    • начального состояния,
    • функции-шага, обновляющей состояние согласно входному символу,
    • функции для превращения состояния в окончательный ответ-результат,
    • типов состояния и результата.

    Давайте это запишем:


    class Statistic s res st | res -> s, st -> s
                             , s -> res, s -> st
                             where
      initState :: st
      extractState :: st -> res
      step :: st -> Word8 -> st

    где s обозначает идентификатор статистики (чуть позже это будет штука из DataKinds), и мы используем функциональные зависимости для выражения того, что статистика единственным образом определяет типы состояния и результата, и наоборот. В частности, это освобождает нас от потребности перечислять все типы-параметры тайпкласса в каждом методе: иначе нам бы пришлось писать


      initState :: proxy1 s -> proxy2 res -> st
      extractState :: proxy s -> st -> res
      step :: proxy1 s -> proxy2 res -> st -> Word8 -> st

    К счастью, функциональные зависимости позволяют компилятору вывести все переменные типов, даже если упомянута всего одна из них, так что мы можем писать короткие и ясные сигнатуры.


    Кстати, заметим, что мы могли бы пользоваться и куда более мощными и общими семействами типов, что дало бы инъективность в одну из сторон, но выражение статистик через мультипараметрический тайпкласс с функциональными зависимостями кажется мне более интуитивным и естественным в этой задаче.


    Статистики по чанкам


    Пока всё вроде бы неплохо, но кое-чего не хватает. Давайте подумаем, как бы мы могли выразить, например, подсчёт количества байт. Если пользователь запросил только эту статистику, то нам совершенно не обязательно побайтово пробегать всю строку, инкрементируя счётчик на каждой итерации. Вместо этого мы могли бы просто взять длину всей строки и радоваться жизни, сведя сложность задачи с $O(n)$ до $O(1)$. С другой стороны, подсчёт слов (или, что ещё сложнее, подсчёт максимальной длины строки) не имеет подобной легко выразимой «чанковой» структуры (если не рассматривать различные хитроумные SIMD-реализации, анализ которых сильно вне темы этого поста). Кроме того, чуть позже мы захотим совмещать статистики. Если все из них поддерживают чанковый режим вычислений, то и результат тоже его поддерживает, а иначе придётся откатиться до побайтового анализа.


    Так как мы можем выразить, что некоторые статистики поддерживают и чанковый, и побайтовый режим вычислений, тогда как другие обязаны вычисляться побайтово? Здесь нам поможет GADT! Мы добавим тип-перечисление для определения режима подсчёта статистик, и мы также определим GADT для хранения тех функций, которые имеют смысл для данного режима. Или в коде:


    data StatCompTyOf = Chunked | ByteOnly
    
    data StatComputation st compTy where
      ChunkedComputation :: (st -> Word8 -> st)
                         -> (st -> BS.ByteString -> st)
                         -> StatComputation st 'Chunked
      ByteOnlyComputation :: (st -> Word8 -> st)
                          -> StatComputation st 'ByteOnly

    Здесь (и в последующем изложении) BS — модуль, соответствующий строгим байтовым строкам.


    Мы также поменяем наш класс Statistic, добавив туда ещё один параметр comp и заменив метод step на более общий computation:


    class Statistic s res st comp | res -> s, st -> s
                                  , s -> res, s -> st, s -> comp
                                  where
      initState :: st
      extractState :: st -> res
      computation :: StatComputation st comp

    И здесь нам снова помогают функциональные зависимости. Достаточно знать значение либо s, либо res, либо st, чтобы вывести значения всех остальных переменных.


    Кроме того, явно отметим, что этот подход легко обобщить для поддержки большего количества видов вычислений. Например, можно добавить поддержку SIMD-ускоренных функций, обрабатывающих по 16-32 байта за раз. Однако для простоты изложения мы на это отвлекаться не будем.


    Реализация статистик


    Какие у нас будут статистики? Давайте реализуем следующие:


    • число байт,
    • число (UTF-8)-символов,
    • число слов,
    • максимальная длина строки,
    • количество строк.

    Или в коде:


    data Statistics = Bytes | Chars | Words | MaxLL | Lines deriving (Eq, Ord)

    Этого должно быть более чем достаточно для иллюстрации подхода, да и wc других статистик особо не предлагает.


    Тогда базовые статистики — это всего лишь реализации класса Statistic. И, так как состояние большинства статистик — одно число, давайте для удобства добавим типизированную обёртку:


    newtype Tagged a = Tagged Word64 deriving (Eq, Show, Num)

    здесь a предназначен исключительно для того, чтобы отличить Tagged 'Bytes от Tagged 'Chars.


    Теперь мы можем написать самую простую статистику: подсчёт количества байт:


    instance Statistic 'Bytes (Tagged 'Bytes) (Tagged 'Bytes) 'Chunked where
      initState = 0
      extractState = id
      computation = ChunkedComputation (\st _ -> st + 1) (\st str -> st + fromIntegral (BS.length str))

    Это, пожалуй, достаточно самодокументируемый код:


    1. Мы говорим, что Bytes обозначает статистику, у которой Tagged 'Bytes является и типом состояния, и типом результата. Кроме того, эта статистика поддерживает чанковые вычисления.
    2. Начальное состояние (то есть, количество байт) равно 0.
    3. Для того, чтобы получить результат из состояния, не нужно делать ничего особенного — состояние и есть результат.
    4. computation обязательно должно быть чанковым вычислением, так как мы сказали 'Chunked на первой строке. Функция шага игнорирует текущий символ и просто увеличивает счётчик, а чанковая функция прибавляет ко счётчику всю длину входа.

    Пока что вроде всё просто и понятно.


    Остальные статистики реализуются аналогично, и реализации довольно скучны, так что я их спрячу под спойлер, но заинтересованный читатель приглашается


    посмотреть.

    Подсчёт строк тоже довольно прост, и эта статистика тоже поддерживает как побайтовые, так и чанковые вычисления:


    instance Statistic 'Lines (Tagged 'Lines) (Tagged 'Lines) 'Chunked where
      initState = 0
      extractState = id
      computation = ChunkedComputation (\st c -> st + if c == 10 then 1 else 0) (\st str -> st + fromIntegral (BS.count 10 str))

    Что насчёт подсчёта слов? Здесь мы поддерживаем только побайтовый подсчёт и заимствуем реализацию из предыдущего поста:


    data WordsState = WordsState { ws :: Word64, wasSpace :: Word64 }
    
    instance Statistic 'Words (Tagged 'Words) WordsState 'ByteOnly where
      initState = WordsState 0 1
      extractState WordsState { .. } = Tagged (ws + 1 - wasSpace)
      computation = ByteOnlyComputation step
        where
          step WordsState { .. } c = WordsState (ws + (1 - wasSpace) * isSp) isSp
            where
              isSp | c == 32 || c - 9 <= 4 = 1
                   | otherwise = 0

    Кроме того, это хороший пример статистики с нетривиальной функцией преобразования состояния в результат.


    Итак, мы портировали те статистики, что мы уже реализовали ранее. Что насчёт новеньких — подсчёта UTF-8-символов и максимальной длины строки?


    Вся сложность подсчёта символов состоит в аккуратном жонглировании битами:


    instance Statistic 'Chars (Tagged 'Chars) (Tagged 'Chars) 'ByteOnly where
      initState = 0
      extractState = id
      computation = ByteOnlyComputation $ \cnt c ->
            cnt + 1 - fromIntegral (   ((c .&. 0b10000000) `shiftR` 7)
                                   .&. (1 - ((c .&. 0b01000000) `shiftR` 6))
                                   )

    Здесь мы опираемся на следующее свойство кодировки UTF-8: каждый символ имеет один и только один байт, который не следует паттерну 10xxxxxx. Другими словами, нам не нужно полноценно декодировать UTF-8 только для того, чтобы подсчитать количество символов.


    Что насчёт максимальной длины строки? Тут вся сложность в корректном учёте непечатаемых символов и правильной обработке символов табуляции (кстати, тут, как и во всех прочих статистиках кроме предыдущей, мы ограничиваемся ASCII):


    instance Statistic 'MaxLL (Tagged 'MaxLL) MaxLLState 'ByteOnly where
      initState = MaxLLState 0 0
      extractState MaxLLState { .. } = Tagged $ max maxLen curLen
      computation = ByteOnlyComputation step
        where
          step MaxLLState { .. } 9 = MaxLLState maxLen $ curLen + 8 - (curLen `rem` 8)
          step MaxLLState { .. } 8 = MaxLLState maxLen $ max 0 (curLen - 1)
          step MaxLLState { .. } c | c == 10
                                  || c == 12
                                  || c == 13 = MaxLLState (max maxLen curLen) 0
                                   | c < 32 = MaxLLState maxLen curLen
          step MaxLLState { .. } _ = MaxLLState maxLen (curLen + 1)

    Кстати, эта функция даже корректно обрабатывает backspace, в отличие от wc!


    Итак, у нас есть все базовые статистики. Теперь можно перейти к самому интересному: их комбинированию.


    Комбинирование статистик


    Если a — статистика, и b — статистика, то их пара — тоже статистика, и это наш шаг индукции. Давайте начнём с реализации типа для пары статистик:


    infixr 5 :::
    data a ::: b = a ::: b deriving (Show)

    Мы также могли использовать обычный тип (,), но теперь нам не нужно думать о том, сможет ли компилятор избежать ленивости или нет, да и, на мой взгляд, этот отдельный тип сделает поднятый на уровень типов код более читабельным.


    Теперь выразим, как совмещать статистики.


    Во-первых, что насчёт комбинирования чанковых и побайтовых статистик? Если обе поддерживают чанковые вычисления, то и результат их поддерживает, иначе придётся ограничиться побайтовым подсчётом. На языке типов это можно выразить так:


    type family CombineCompTy a b where
      CombineCompTy 'Chunked 'Chunked = 'Chunked
      CombineCompTy _ _ = 'ByteOnly

    Как инстанс класса Statistic выглядит для пары статистик? Можно написать что-то такое:


    instance (Statistic sa resa sta compa, Statistic sb resb stb compb)
           => Statistic (sa '::: sb) (resa ::: resb) (sta ::: stb) (CombineCompTy compa compb) where
      initState = initState ::: initState
      extractState (a ::: b) = extractState a ::: extractState b
      computation =
        case (computation :: StatComputation sta compa, computation :: StatComputation stb compb) of
             (ByteOnlyComputation a, ChunkedComputation b _)
                -> ByteOnlyComputation $ combine a b
             (ChunkedComputation a _, ByteOnlyComputation b)
                -> ByteOnlyComputation $ combine a b
             (ByteOnlyComputation a, ByteOnlyComputation b) 
                -> ByteOnlyComputation $ combine a b
             (ChunkedComputation stepA chunkA, ChunkedComputation stepB chunkB)
                -> ChunkedComputation (combine stepA stepB) (combine chunkA chunkB)
        where
          combine fa fb = \(a ::: b) w -> fa a w ::: fb b w

    То есть, если sa — статистика с типом результата resa, типом состояния sta и режимом подсчёта compa, и аналогично для sb/resb/stb/compb, то пара sa ::: sb — тоже статистика, причём её тип результата — пара resa ::: resb, тип состояния — пара sta ::: stb, а режим вычисления — результат функции на уровне типов CombineCompTy compa compb.


    Заметьте разницу между (с крыжечкой, запромоученным) :::-в-роли-конструктора и (без крыжечки, незапромоученным) :::-в-роли-типа в определении инстанса. sa и sbтермы, запромоученные на уровень типов, поэтому рядом с ними мы используем (запромоученный) конструктор термов, тогда как остальные переменные — типы, так что рядом с ними мы используем (незапромоученный) конструктор типов.


    Всё бы хорошо, вот только… мы не можем написать такой инстанс. В текущем хаскеле нельзя использовать семейство типов в таком виде. К счастью, это легко обойти добавлением новой переменной comp вместе с ограничением, что она должна быть равна результату применения этого семейства типов:


    instance (Statistic sa resa sta compa,
              Statistic sb resb stb compb,
              comp ~ CombineCompTy compa compb)
           => Statistic (sa '::: sb) (resa ::: resb) (sta ::: stb) comp where

    Остальная часть инстанса никак не меняется.


    Давайте теперь разбирать термы. Первые два метода просты:


    1. Начальное состояние пары статистик равно паре из начальных состояний соответствующих статистик.
    2. Чтобы достать ответ из состояния для пары статистик, нужно достать ответы из соответствующих компонент состояния-пары и сделать из них пару.

    Кстати, нам тут не нужна ни единая аннотация типов — компилятор может вывести всё сам, и это очень круто!


    Третий метод уже поинтереснее и куда более многословен, но он по большому счёту следует за определением CombineCompTy (и тайпчекер это на самом деле проверяет). Опять же, если обе статистики поддерживают чанковые вычисления, то и результирующая статистика их поддерживает (это последний случай), а иначе всё сводится к побайтовому вычислению.


    Основная часть бойлерплейта происходит от необходимости явного паттерн-матчинга по хотя бы одному из вычислителей, который, в свою очередь, нужен для того, чтобы тайпчекер мог убедиться, что правая часть каждой ветки case имеет правильный тип.


    А какой тип правильный? Согласно определению класса, это StatComputation st comp, где, согласно определению инстанса, comp ~ CombineCompTy compa compb. То есть, ожидаемый тип зависит от конкретных compa и compb. А чтобы вычислить CombineCompTy, тайпчекер должен знать, равны ли Chunked и compa, и compb, или нет.


    Откуда тайпчекер знает значение compa или compb? А в общем случае он и не знает. Однако, если мы сматчимся по результату соответствующего computation, то тогда нам поможет логика GADT. Действительно, посмотрим ещё раз на определение типа StatComputation. Если значение этого типа было создано при помощи конструктора ChunkedComputation, то соответствующая comp обязательно должна быть равна Chunked. Если же использовался конструктор ByteOnlyComputation, то соответствующая переменная равна ByteOnly.


    Кстати, если бы мы написали CombineCompTy без использования _-паттернов, а перечисляя все четыре возможные комбинации, то тайпчекер должен был бы знать значения и compa, и compb.


    Ещё стоит отметить, что такое представление позволяет иметь дубликаты: Words '::: Words соответствует комбинированной статистике, считающей количество слов дважды. Пурис⊤ы на такое бы смотрели неодобрительно, но для наших целей оно вполне подходит, тем более, что чуть позже конкретно эта возможность нам очень пригодится.


    Использование статистик


    Супер, мы написали кучу кода. Как его использовать?


    Пусть нам дан тип, реализующий класс Statistic, и ByteString, по которой надо посчитать статистику. Тогда мы сначала рассмотрим GADT, возвращаемый функцией computation. Если это ChunkedComputation, то мы ему кормим всю входную строку. Иначе это ByteOnlyComputation, и мы делаем BS.foldl'. Или в коде:


    wc :: forall s res st comp. Statistic s res st comp => BS.ByteString -> res
    wc s = extractState $! runCompute computation
      where
        runCompute :: StatComputation st comp -> st
        runCompute (ByteOnlyComputation step) = BS.foldl' step initState s
        runCompute (ChunkedComputation _ chunker) = chunker initState s

    Функциональные зависимости снова нас выручают, так как тайпчекер может вывести все аргументы класса (s, st, comp) по одному лишь желаемому типу результата res. С другой стороны, похоже, тайпчекер не может вывести тип runCompute, так что нам приходится указывать его явно. При этом переменные st и comp в её сигнатуре должны совпадать с переменными в типе wc, а для этого (очень интуитивно) используется forall и расширение ScopedTypeVariables.


    Теперь мы можем выбирать конкретные статистики либо через явную аннотацию типа возвращаемого значения:


    let result = wc someBS :: Tagged 'Words ::: Tagged 'Lines

    либо при помощи расширения TypeApplications и явного указания значения переменной s в сигнатуре функции:


    let result = wc @('Words '::: 'Lines) someBS

    Оба варианта полностью эквивалентны, но, на мой взгляд, второй способ подходит чуть лучше, так как он передаёт смысл кода более очевидным образом.


    Предварительная оценка производительности


    Оправданы ли наши усилия, или же мы занимались всей этой ерундой впустую?


    Давайте измерим, сколько времени занимает wc @'Words, используя всю ту же методологию. Наилучшее время выполнения — 1.51 секунд, немногим больше, чем подсчёт одних лишь байт, слов и строк в немодуляризованной версии. Не фонтан, но не так уж плохо.


    Насколько хорош компилятор в устранении повторяющихся вычислений? Давайте измерим wc @('Words '::: 'Words)!


    Только вот лично у меня здесь начинается полная ерунда. Я бы ожидал, возможно, увидеть чуть большие цифры, в идеале — такие же, но… Оно работает быстрее: 1.34 секунды. А если посчитать wc @('Words '::: 'Words '::: 'Words)? 1.30 секунд. Впрочем, последующее добавление 'Words не помогает.


    Что ещё более странно — эти результаты невоспроизводимы у других людей. Я поспрашивал народ в ирке на канале #haskell — у них этот результат не воспроизводился. Время работы было довольно стабильным и не зависящим от числа дубликатов одного и того же вычисления.


    У меня этому нет хорошего объяснения. Я помедитировал на GHC Core — безрезультатно, всё выглядит разумным. Если бы это было воспроизводимое улучшение, я бы мог потеоретизировать о поведении инлайнера, или специализатора, или о чём-то таком. Но учитывая, что эти результаты не воспроизводятся у других людей… Страннота-ерунда. Я не понимаю, почему код так себя ведёт, и не могу сказать, что мне это нравится.


    Ладно, хватит ныть, давайте ещё поизмеряем. Что насчёт всех трёх статистик, которые у нас были раньше? Измерим wc @('Bytes '::: 'Words '::: 'Lines)! Время работы в этом случае — 1.53 секунды. Это немногим хуже 1.45 секунд, которые у нас были раньше, но, на мой взгляд, вполне терпимо.


    Итак, мы эмпирически доказали, что у этого подхода хотя бы есть шанс. Давайте теперь посмотрим, какие плоды нам даёт такая модуляризация.


    Тестирование


    Тестировать такой код — одно удовольствие! Локальность рассуждений позволяет протестировать каждую статистику в отдельности и при этом даёт уверенность, что они работают корректно в любой комбинации.


    Например, мы можем проверить, что для любой строки количество слов равно длине списка, возвращаемого стандартной функцией words, если проигнорировать все символы с кодом выше 127. В частности, мы можем считать это определяющим свойством нашей статистики подсчёта слов, но это уже скорее вопрос философских взглядов.


    В коде это выражается как набор QuickCheck-свойств, записанных и для ASCII, и для UTF-8-входов:


    import qualified Data.ByteString.Char8 as BS
    import qualified Data.Text as T
    import qualified Data.Text.Encoding as T
    -- ещё скучные импорты
    
    import Data.WordCount
    
    wrapUnicode :: UnicodeString -> (BS.ByteString, T.Text)
    wrapUnicode ustr = (T.encodeUtf8 txt, txt)
      where
        txt = T.pack $ getUnicodeString ustr
    
    replaceNonAsciiSpaces :: Char -> Char
    replaceNonAsciiSpaces ch | ch >= chr 127 && isSpace ch = '_'
                             | otherwise = ch
    
    main :: IO ()
    main = hspec $ parallel $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 1000) $ do
      describe "ASCII support" $ do
        it "Counts bytes correctly" $ property $
          \(getASCIIString -> str) -> wc @'Bytes (BS.pack str) `shouldBe` genericLength str
        it "Counts chars correctly" $ property $
          \(getASCIIString -> str) -> wc @'Chars (BS.pack str) `shouldBe` genericLength str
        it "Counts words correctly" $ property $
          \(getASCIIString -> str) -> wc @'Words (BS.pack str) `shouldBe` genericLength (words str)
        it "Counts lines correctly" $ property $
          \(getASCIIString -> str) -> wc @'Lines (BS.pack str) `shouldBe` genericLength (filter (== '\n') str)
      describe "UTF8 support" $ do
        it "Counts bytes correctly" $ property $
          \(wrapUnicode -> (bs, _))   -> wc @'Bytes bs `shouldBe` fromIntegral (BS.length bs)
        it "Counts chars correctly" $ property $
          \(wrapUnicode -> (bs, txt)) -> wc @'Chars bs `shouldBe` fromIntegral (T.length txt)
        it "Counts words correctly" $ property $
          \(wrapUnicode -> (bs, txt)) -> wc @'Words bs `shouldBe` genericLength (T.words $ T.map replaceNonAsciiSpaces txt)
        it "Counts lines correctly" $ property $
          \(wrapUnicode -> (bs, txt)) -> wc @'Lines bs `shouldBe` fromIntegral (T.count "\n" txt)

    И всё!


    Заметим несколько вещей:


    • В более выразительном языке мы могли бы сформулировать эти свойства как полноценные теоремы и вполне могли бы их доказать внутри языка, что даёт куда большую уверенность в корректности, чем несколько тысяч случайно сгенерированных примеров. В самом деле, кое-какой баг в реализации функции подсчёта количества UTF-8-символов в среднем ловился только на входе из второй или третьей тысячи примеров.
    • Мы не формулируем и не проверяем никакие свойства для функции подсчёта длины строк, так как это… нетривиально.
    • Тесты исполняются достаточно быстро: прогнать их все на 10 тысячах примеров (для каждого свойства) длиной до тысячи символов занимает 3-5 секунд на моей машине (с учётом создания тестовых данных).

    В любом случае, читателю предлагается реализовать что-то подобное для версии на C из GNU Coreutils.


    Обработка опций командной строки


    Воспользуемся библиотекой optparse-applicative. Определим тип, хранящий опции командной строки, и парсер для него:


    data Options = Options
      { countBytes :: Bool
      , countChars :: Bool
      , countLines :: Bool
      , countMaxLineLength :: Bool
      , countWords :: Bool
      , files :: [FilePath]
      }
    
    options :: Parser Options
    options = Options
      <$> switch (long "bytes" <> short 'c' <> help "print the byte counts")
      <*> switch (long "chars" <> short 'm' <> help "print the character counts")
      <*> switch (long "lines" <> short 'l' <> help "print the newline counts")
      <*> switch (long "max-line-length" <> short 'L' <> help "print the maximum display width")
      <*> switch (long "words" <> short 'w' <> help "print the word counts")
      <*> some (argument str (metavar "FILES..."))

    Модифицируем наш main, чтобы распарсить командную строку и отобразить опции на значения типа Statistics, подсчитывая байты, слова и строки по умолчанию:


    main :: IO ()
    main = do
      Options { .. } <- execParser $ info (options <**> helper) (fullDesc <> progDesc "Print newline, word, and byte counts for each file")
      let selectedStats = map snd $ filter fst [ (countBytes, Bytes), (countChars, Chars)
                                               , (countWords, Words), (countMaxLineLength, MaxLL)
                                               , (countLines, Lines)
                                               ]
      let stats | null selectedStats = [Bytes, Words, Lines]
                | otherwise = selectedStats

    Всё это наверняка можно сделать ещё элегантнее, но цель статьи не в описании парсинга командной строки, так что нам бы уж хоть как-нибудь получить список опций.


    Итак, список опций мы получили. Что мы делаем дальше? Нам нужно сконвертировать этот список в тип, который мы можем скормить wc. Другими словами, у нас есть терм, и нам из него нужно сделать тип. Звучит прямо как зависимые типы!


    Почти зависимые типы


    Этот подход обречён с точки зрения производительности по причинам, которые будут понятны позднее, но давайте всё равно его попробуем, ведь так мы сможем посмотреть, как писать что-то околозависимотипизированное в современном хаскеле, а зависимые типы — это круто!


    Мы будем строить решение маленькими шажочками и вручную, без использования синглтонов, чтобы лучше прочувствовать, как работает система типов и какие у неё ограничения.


    Мы не знаем, какие статистики мы будем считать во время выполнения, поэтому мы заворачиваем их в экзистенциальный тип:


    data SomeStats where
      MkSomeStats :: Statistic s res st comp => proxy s -> SomeStats

    Здесь proxy s — свидетель конкретного инстанса Statistic. Его единственная задача — обеспечить нас конкретным типом статистики.


    Пусть теперь у нас есть значение этого экзистенциального типа. Как мы можем им пользоваться? Можно попробовать что-то такое:


    wc' :: SomeStats -> BS.ByteString -> ?
    wc' (MkSomeStats (_ :: proxy s)) input = wc @s input

    но… Что мы должны написать вместо ?? Какой возвращаемый тип этой функции? Понятно, что это res из соответствующего инстанса Statistic, но у нас его здесь нет.


    Может, попробовать написать как-то так?


    data SomeStats where
      MkSomeStats :: Statistic s res st comp => proxy1 s -> proxy2 res -> SomeStats
    
    wc' :: SomeStats -> BS.ByteString -> res
    wc' (MkSomeStats (_ :: proxy1 s) (_ :: proxy2 res)) input = wc @s input

    Но на самом деле понятно, что это работать не будет: в точке определения типа wc' нам ещё никакой res, завёрнутый внутрь SomeStats, не доступен.


    Что же делать?


    Давайте сделаем шаг назад и подумаем. Мы действительно не знаем конкретный возвращаемый тип wc, но нам это и не нужно! Достаточно того, что его можно показать пользователю. Иными словами, нам важно только то, что мы можем, например, преобразовать его в строку при помощи show, для чего достаточно добавить констрейнт, что res реализует Show:


    data SomeStats where
      MkSomeStats :: (Statistic s res st comp, Show res) => proxy s -> SomeStats

    Тогда wc будет выглядеть примерно так:


    wc' :: SomeStats -> BS.ByteString -> String
    wc' (MkSomeStats (_ :: proxy s)) input = show $ wc @s input

    и это корректно типизированный код.


    Хорошо, но как теперь преобразовать наш список stats в SomeStats? Давайте начнём с промоутинга базовых статистик:


    promoteStat :: Statistics -> SomeStats
    promoteStat Bytes = MkSomeStats (Proxy :: Proxy 'Bytes)
    promoteStat Chars = MkSomeStats (Proxy :: Proxy 'Chars)
    promoteStat Words = MkSomeStats (Proxy :: Proxy 'Words)
    promoteStat MaxLL = MkSomeStats (Proxy :: Proxy 'MaxLL)
    promoteStat Lines = MkSomeStats (Proxy :: Proxy 'Lines)

    Довольно уродливо, да и грустно, что нужно вручную перечислить все значения типа Statistics, но таково ограничение системы типов хаскеля. Вот тебе и эрзац-зависимые типы: несмотря на то, что терм Bytes и (запромоученный) тип 'Bytes выглядят одинаково, тайпчекер их считает совершенно разными сущностями без всякой связи между ними, и нам приходится устанавливать эту связь вручную.


    В любом случае, с этим нашим promoteStat теперь можно пройтись и по всему списку целиком:


    promoteStats :: [Statistics] -> SomeStats
    promoteStats [s] = promoteStat s
    promoteStats (s:ss) =
      case (promoteStat s, promoteStats ss) of
           (MkSomeStats (_ :: proxy1 st), MkSomeStats (_ :: proxy2 sst))
                                       -> MkSomeStats (Proxy :: Proxy (st '::: sst))

    Для списка, состоящего из одного элемента, мы просто используем функцию promoteStat.


    Если же список состоит из двух и более элементов, то всё куда интереснее. Сначала всё относительно стандартно для рекурсивных функций: голову мы промоутим при помощи того же promoteStat, а хвост обрабатываем рекурсивным вызовом promoteStats. Дальше их надо как-то совместить, и здесь начинается лёгкая магия. Мы матчимся по результатам вызовов promoteStat и promoteStats, привязывая переменную типа st к типу, соответствующему голове списка, а sst — к типу, соответствующему хвосту.


    Мы ничего не знаем об этих типах кроме того, что они реализуют класс Statistic (так как это требуется констрейнтом в соответствующем конструкторе экзистенциального типа). Но если они реализуют Statistic, то и st ::: sst реализует Statistic как раз из-за комбинирующего инстанса, который мы написали выше! Кроме того, мы знаем, что rest и resst (некоторые воображаемые безымянные переменные типов, соответствующие результатам статистик st и sst) реализуют Show. Поэтому можно вывести, что rest ::: resst также реализует Show, а это ровным счётом тип результата статистики st ::: sst!


    Короче, в итоге получается, что выражение MkSomeStats (Proxy :: Proxy (st '::: sst)) вполне корректно типизировано. И очень круто, что тайпчекер может это всё сам вывести!


    Кстати, это не тотальная функция: мы не обрабатываем случай пустого списка опций. С другой стороны, он у нас никогда и не возникнет, а использование вещей вроде NonEmpty усложнит изложение без всякой видимой выгоды.


    Как бы там ни было, пользоваться этой функцией легко:


    main :: IO ()
    main = do
      -- obtaining `stats` as before
      forM_ files $ \path -> do
        contents <- unsafeMMapFile path
        putStrLn $ wc' (promoteStats stats) contents

    Чудеса производительности


    Насколько (не)эффективен этот подход?


    Если посчитать только строки, то мы получим многообещающие 1.05 секунд — ровно столько же, сколько занимает BS.count 10.


    Но это чанковая статистика, обрабатывающая весь вход за раз. Как насчёт побайтовых статистик, например, числа слов? Запускам, получаем… 14 секунд вместо полутора.


    Чёрт, 14 секунд.


    И, кстати, оно жуёт память как бешеное:


      74,873,139,008 bytes allocated in the heap

    Я не проводил систематических замеров аллокаций для прошлых версий, но это число всегда было меньше мегабайта. Ну, хотя бы эта версия всё ещё $O(1)$ по памяти — большинство аллокаций почти сразу умирают в нулевом поколении GC (60,512 bytes maximum residency).


    Ладно. Что, если мы посчитаем и слова, и строки? 27 секунд, 120 гигабайт аллоцировано.


    Что насчёт слов, строк и байт? Можете угадать?


    Если вы сказали «42 секунды», то можете съесть пирожок: оно выполняется 41 секунду и аллоцирует 194 гигабайта. Ну, максимальное потребление памяти согласно RTS хотя бы всё ещё в районе 60 килобайт.


    Почему всё так плохо?


    Ну, когда мы пишем такую функцию:


    wc' (MkSomeStats (_ :: proxy s)) input = show $ wc @s input

    тогда компилятор никак не может знать, какой computation связан с данной конкретной s — это исключительно рантайм-свойство, известное только после того, как пользователь сделает свой выбор. Поэтому у компилятора нет другого выхода, кроме как скомпилировать это в прямую передачу словаря методов класса Statistic и вызова методов этого словаря по указателю без какого бы то ни было инлайнинга.


    Так что конкретно здесь происходит?


    Функция wc' получает указатель на функцию computation, обёрнутый в значение экзистенциального типа SomeStats и передаёт этот указатель дальше функции wc, которая вызывает функцию по этому указателю для каждого входного байта. Никакого инлайнинга, никаких связанных с этим оптимизаций, никаких горячих циклов, а вместо этого всего вызов функции на каждой итерации. То есть, это примерно 1.8 миллиардов вызовов — конечно же это будет медленно!


    При этом вызывающая сторона ответственна за упаковку всех нужных указателей в экзистенциальный тип при помощи функции promoteStats. Как именно она это делает?


    Например, если stats состоит из единственного элемента, то используется уравнение


    promoteStats [s] = promoteStat s

    и если s оказывается, например, Words, то promoteStat вычисляется согласно уравнению


    promoteStat Words = MkSomeStats (Proxy :: Proxy 'Words)

    В итоге promoteStats заворачивает в SomeStats указатели на методы, соответствующие реализации Statistic для Words.


    Но это простой случай. Что происходит, если в дело вступает второе уравнение?


    promoteStats (s:ss) =
      case (promoteStat s, promoteStats ss) of
             (MkSomeStats (_ :: proxy1 st), MkSomeStats (_ :: proxy2 sst)) -> MkSomeStats (Proxy :: Proxy (st '::: sst))

    Тогда указатель на фукнцию computation строится примерно следующим образом: case в правой части уравнения извлекает указатели из того, что вернули promoteStat и рекурсивный вызов promoteStats, и, если упрощать, передаёт их функции computation реализации Statistic для «индуктивного» случая sa ::: sb, которая, в свою очередь, вызывает функции по этим указателям один за другим.


    Поэтому если список опций состоит из двух статистик, мы платим оверхед в 13-14 секунд дважды, и общее время выполнения должно быть в районе 28 секунд — ровно как мы и наблюдали. А если бы мы выбрали все пять статистик, то время работы было бы 65-70 секунд.


    Так что понимание того, как работают экзистенциальные типы (да и вообще стирание типов) позволяет заранее ожидать исключительно хреновую производительность такого подхода.


    Кстати, мы заодно можем оценить стоимость вызова функции. Оверхед составляет 13 секунд (14 секунд на всё минус 1 секунда на бизнес-логику) на 1.8 миллиардов вызовов — то есть, примерно 7 наносекунд на вызов. Звучит разумно.


    Уродливый подход


    Однако это упражнение с экзистенциальными типами позволяет нам ограничить пространство возможных решений: мы хотим убедиться, что компилятор видит точный (мономорфизированный) тип wc в каждой точке вызова. В идеале у нас бы было что-то вроде


    main = do
      -- ..
      case stats of
           [Words] -> print $ wc @'Words contents
           [Bytes] -> print $ wc @'Bytes contents
           [Lines] -> print $ wc @'Lines contents
           [Words, Bytes] -> print $ wc @('Words '::: 'Bytes) contents
           [Lines, Bytes] -> print $ wc @('Lines '::: 'Bytes) contents
           -- ...

    и так далее. Но даже если у нас всего лишь пять возможных статистик, то школьная комбинаторика говорит нам, что у нас будет $2^5 - 1 = 31$ ветка в case. Понятно, что писать их все — не выход.


    Вот только компилятор может нам помочь их написать, для чего нам придётся прибегнуть к Template Haskell. Мы напишем (мета-)функцию dispatch, которая будет использоваться так:


      contents <- unsafeMMapFile path
      putStrLn $ $(dispatch 'wc 'contents) stats

    Здесь $(dispatch 'wc 'contents) создаёт функцию, которая делает case-анализ stats примерно так же, как приведённый чуть выше пример.


    Написание dispatch — довольно техническое упражнение в Template Haskell, поэтому я просто покажу, что в итоге получается:


    dispatch :: Name -> Name -> Q Exp
    dispatch fun bs = reify ''Statistics >>= \case
      TyConI (DataD _ _ _ _ cons _) -> do
        let consNames = [ name | NormalC name _ <- cons ]
        let powerset = filterM (const [True, False]) consNames
        let matches = buildMatch fun bs <$> filter (not . null) powerset
        fallbackMatch <- (\body -> Match WildP (NormalB body) []) <$> [e| error "Unexpected input" |]
        pure $ LamCaseE $ matches <> [fallbackMatch]
      _ -> fail "unsupported type"
    
    buildMatch :: Name -> Name -> [Name] -> Match
    buildMatch fun bs consNames = Match (ListP $ (`ConP` []) <$> consNames) (NormalB $ VarE 'show `AppE` (wcCall `AppE` VarE bs)) []
      where
        wcCall = VarE fun `AppTypeE` foldr1 f (PromotedT <$> consNames)
        f accTy promotedTy = PromotedT '(:::) `AppT` accTy `AppT` promotedTy

    Если совсем вкратце, то мы узнаём все конструкторы типа Statistics (поэтому, кстати, добавить новые статистики будет очень легко), и для каждого непустого подмножества множества конструкторов (то есть, для каждого непустого элемента в powerset) мы строим отдельную case-ветку при помощи buildMatch. Все построенные ветки мы заворачиваем в один большой лямбда-case (с расширением {-# LANGUAGE LambdaCase #-}).


    Кстати, довольно забавно, что тут мы можем немного подзабить на корректную обработку ошибок и тотальность функций, так как всё равно этот код будет выполняться во время компиляции, и все возможные ошибки вылезут тогда же.


    Единственная вещь, которая немного меня коробит (ну, кроме использования TH) — получаемая функция ожидает, что массив stats будет отсортированным. Можно оправдать это ожидание двумя способами. С одной стороны, мы можем аккуратно выбрать порядок элементов в списке


      let selectedStats = map snd $ filter fst [ (countBytes, Bytes), (countChars, Chars)
                                               , (countWords, Words), (countMaxLineLength, MaxLL)
                                               , (countLines, Lines)
                                               ]

    согласно порядку, порождаемому сгенерированной компилятором реализацией Ord. С другой стороны, мы можем просто явно сортировать список stats. Оба подхода вполне работают, однако второй чуть чище и надёжнее, а потери в производительности из-за сортировки stats, очевидно, пренебрежимо малы.


    Давайте теперь сложим все кусочки вместе!


    main :: IO ()
    main = do
      Options { .. } <- execParser $ info (options <**> helper) (fullDesc <> progDesc "Print newline, word, and byte counts for each file")
      let selectedStats = map snd $ filter fst [ (countBytes, Bytes), (countChars, Chars)
                                               , (countWords, Words), (countMaxLineLength, MaxLL)
                                               , (countLines, Lines)
                                               ]
      let stats | null selectedStats = [Bytes, Words, Lines]
                | otherwise = selectedStats
      forM_ files $ \path -> do
        contents <- unsafeMMapFile path
        putStrLn $ $(dispatch 'wc 'contents) stats

    Окончательная производительность


    Насколько хорошо работает этот подход? Я не буду проверять все комбинации параметров (31 вариант — слишком много), поэтому выберу какое-то случайное их подмножество. Кроме того, в этот раз я снова возьму wc из GNU Coreutils в качестве некоторой базовой точки, чтобы привязать эти измерения хоть к чему-то. Бенчмаркинг производится так же, как и всегда: каждый тест запускается 5 раз на тестовом файле в 1.8 гигабайт, и рассматривается минимальное время в юзерспейсе. wc из Coreutils запускается с переменными окружения LC_ALL=C LANG=C, если не указано иное.


    Вот результаты:


    Слова Байты Строки Символы Длина строки Haskell wc, с Coreutils wc, с
    0.00 ¹ 0.00 ¹
    1.54 12.5
    1.20 12.5
    1.06 / 0.24 ² 0.26
    1.52 12.5
    1.42 8.45 ³
    2.21 12.5
    2.92 12.5

    Некоторые наблюдения и замечания:


    • Мне всё ещё рвёт шаблон, что подсчёт байт и слов быстрее, чем подсчёт одних лишь слов.
    • Похоже, что версия на C всегда считает некоторый базовый набор статистик (слова, байты, строки и максимальную длину строк) если включён либо подсчёт строк, либо подсчёт максимальной длины. Я не удивлён.
    • ¹ Да, time буквально показывает 0.00user для обоих программ в случае подсчёта байт.
    • ² Первое число для подсчёта байт и строк (1.06 секунд) — результат с апстримовой библиотекой bytestring. Второе число — с пропатченной bytestring, где функция подсчёта количества вхождений символа (count) оптимизирована с использованием SIMD-интринсиков. По иронии судьбы оригинальная count реализована на C, и, что снова иронично, комплиятор не может её оптимизировать достаточно хорошо, и даже чистая реализация на хаскеле была бы быстрее (хотя и не настолько быстро, как с ручными оптимизациями и SIMD), но всю эту иронию лучше оставить для другого поста.
    • ³ Здесь wc запускается с UTF-8-локалью, так как иначе он понимает, что число символов равно числу байт, и работает за константное время, тогда как мы хотим измерить скорость подсчёта UTF-8-символов.

    На мой взгляд, вполне себе неплохие результаты.


    Всякие мелочи


    Наша программа может обрабатывать опции командной строки, она поддерживает те же статистики, что и wc, она может обрабатывать несколько файлов. Что ещё можно добавить?


    Параллелизм


    Это легко: мы просто заменяем forM_ на forConcurrently_ из библиотеки async:


    main :: IO ()
    main = do
      Options { .. } <- execParser $ info (options <**> helper) (fullDesc <> progDesc "Print newline, word, and byte counts for each file")
      let selectedStats = map snd $ filter fst [ (countBytes, Bytes), (countChars, Chars)
                                               , (countWords, Words), (countMaxLineLength, MaxLL)
                                               , (countLines, Lines)
                                               ]
      let stats | null selectedStats = [Bytes, Words, Lines]
                | otherwise = selectedStats
      forConcurrently_ files $ \path -> do
        contents <- unsafeMMapFile path
        putStrLn $ $(dispatch 'wc 'contents) stats

    Теперь программа будет обрабатывать одновременно столько же файлов, сколько у нас есть ядер (вернее, сколько ядер разрешили использовать хаскелевскому RTS, что по умолчанию равно полному числу ядер). Если бы нас это не устраивало, то можно было бы добавить ещё одну опцию типа -j, но это не так уж сложно и предлагается в качестве упражнения читателю.


    Каков оверхед этого параллелизма?


    Подсчёт слов и байт в одном тестовом файле займёт 1.22 секунд — почти как последовательная версия, хоть и дисперсия значений в этом случае будет повыше.


    Если же мы запустим эту программу, скормив ей наш тестовый файл шесть раз (по числу физических ядер в моей машине), то время работы будет равно 1.47 секунд, но с ещё более существенной дисперсией. Думаю, что в этом случае всё упирается в шину данных.


    Красивая печать


    Если мы сейчас запустим нашу программу, то она распечатает результат в виде


    Tagged 123 ::: (Tagged 456 ::: Tagged 789)

    Это не очень дружественно к пользователю, так что давайте это исправим! Проще всего добавить специальный метод в класс Statistic:


    class Statistic s res st comp | res -> s, st -> s
                                  , s -> res, s -> st, s -> comp where
      -- ...
      prettyPrint :: res -> String

    Его реализация для базовых статистик проста, например:


    instance Statistic 'Bytes (Tagged 'Bytes) (Tagged 'Bytes) 'Chunked where
      -- ...
      prettyPrint (Tagged n) = show n <> " bytes"

    Для комбинации статистик тоже ничего сложного, просто чуть больше писанины:


      prettyPrint (a ::: b) = prettyPrint a <> "\n" <> prettyPrint b

    Мы также должны обновить нашу функцию buildMatch, чтобы она использовала prettyPrint вместо show:


    buildMatch fun bs consNames = Match (ListP $ (`ConP` []) <$> consNames) (NormalB $ VarE 'prettyPrint `AppE` (wcCall `AppE` VarE bs)) []

    И всё!


    Больше видов входных данных


    Пока что наша реализация предполагает, что входной файл всегда можно mmapнуть. Однако, так происходит не всегда: например, наша реализация сломается в случае hwc <(cat foo | grep bar).


    Это можно исправить, проверяя, является ли путь обычным файлом или символьной ссылкой — их-то mmapить можно. Мы будем осторожны и не будем даже пытаться mmapить все остальные виды путей. Вместо этого мы будем их считывать в ленивую ByteString, чтобы пространственная сложность всё ещё была константной. А ленивая ByteString — это практически список строгих чанков, так что мы можем по ним просто свернуться в случае чанковых вычислений:


    import qualified Data.ByteString.Lazy as BSL
    
    wcLazy :: forall s res st comp. Statistic s res st comp => BSL.ByteString -> res
    wcLazy s = extractState $! runCompute computation
      where
        runCompute :: StatComputation st comp -> st
        runCompute (ByteOnlyComputation step) = BSL.foldl' step initState s
        runCompute (ChunkedComputation _ chunker) = BSL.foldlChunks chunker initState s

    Теперь мы можем модифицировать наш main:


      forConcurrently_ files $ \path -> do
        stat <- getFileStatus path
        if isRegularFile stat || isSymbolicLink stat
          then countStrict stats $ unsafeMMapFile path
          else countLazy stats $ BSL.readFile path

    где мы добавили две маленьких вспомогательных функции:


      where
        countStrict stats act = do
          contents <- act
          putStrLn $ $(dispatch 'wc 'contents) stats
        countLazy stats act = do
          contents <- act
          putStrLn $ $(dispatch 'wcLazy 'contents) stats

    И всё!


    Заметим, что на самом деле вместо добавления функции wcLazy мы могли бы создать ещё один тайпкласс, описывающий тип входной строки, но так как их предполагается всего две и больше не будет, то пользы от этого мало.


    Поддержка stdin


    Ещё одна вещь, которую умеет Coreutils wc, но не умеет наша версия — поддержка stdin. Исправить это просто, добавив проверку в конец main:


    main = do
      -- ... as before ...
    
      when (null files) $ countLazy stats BSL.getContents

    Теперь можно делать что-то вроде


    cat testfile.txt | /usr/bin/time hwc-exe -cw

    Насколько хуже такой подход с точки зрения производительности? Ну, например, вышеприведённая команда выполняется за 1.40 секунд — то есть, разница с 1.22 секундами ранее вполне себе заметна.


    Время компиляции и распухание кода


    Здесь я действительно придираюсь, но давайте это тоже упомянем ради какой-никакой объективности: каков оверхед всего этого метапрограммирования? Мы можем говорить либо о времени компиляции, либо о размере получающегося файла, так что давайте рассмотрим обе эти метрики!


    Если мы пойдём по «зависимо типизированной» дороге (которую можно считать чем-то вроде базы в этом случае), то stack build займёт 7.9 секунд для всего проекта, и размер результирующего бинарника окажется равен 2.24 мегабайта (после strip).


    Подход с Template Haskell компилируется ровно втрое дольше: 23 секунды. С другой стороны, бинарник и не распух толком (особенно учитывая 31 вариант вызова функции): его размер стал 2.34 мегабайта, разница — 4.3%.


    Хотя… Во время обычной разработки никто не делает stack build (так как это сборка с оптимизациями). stack build --fast может оказаться куда быстрее.


    «Зависимо типизированная» реализация компилируется за 5.6 секунд с --fast, тогда как версия с TH собирается за… 7.8 секунд. Тут уже разница не такая уж и большая. С этим можно жить.


    И я знаю, что для части разработчиков это очень важный фактор, так что давайте сравним время компиляции в релизном режиме и размер бинарника с C. Как и ожидалось, хаскель здесь сливает подчистую: на моей машине wc из GNU Coreutils компилируется за 0.06 секунд, и результирующий размер бинарника — 21 килобайт. Бинарник wc с убунты занимает 24 килобайта. В 100 раз меньше, чем хаскель!


    Ну, другие мелочи и придирки мне в голову не пришли, так что давайте закругляться и переходить к заключению.


    Заключение


    Что у нас получилось? Если вкратце, то мы привели наш исходный прототип wc к виду, который куда больше напоминает стандартные Unix-утилиты, и теперь наш хаскель-wc готов для того, чтобы использоваться вместо GNU Coreutils wc. Самое главное — он поддерживает пользовательские опции (и больше разных статистик!), да так, что он считает лишь то, что пользователю на самом деле нужно посчитать, при этом с околонулевым оверхедом на модуляризацию. Забавно, что в каком-то смысле у нас довольно легко получилось куда ближе следовать принципу «не платить за то, что не используешь», так милому сердцам программистов на C и C++, чем в случае реализации на C.


    Если более подробно, то мы:


    1. разделили наш изначальный прототип wc на набор маленьких, изолированных, тестируемых и композабельных кусочков, по одному на статистику;
    2. научились совмещать эти кусочки вместе;
    3. написали тесты для статистик по отдельности, будучи уверенными, что вместе они тоже будут работать правильно в любых комбинациях по построению;
    4. попытались считать только то, что выбрал пользователь, используя техники, вдохновлённые зависимыми типами, и полюбовались, как красочно и громко эти техники сливают с точки зрения производительности в случае хаскеля;
    5. преодолели все проблемы с производительностью обработки опций командной строки при помощи Template Haskell;
    6. проверили, что результат весьма близок с точки зрения производительности к нашей изначальной реализации, так что вся эта модульность не имеет существенного влияния на производительность;
    7. реализовали несколько других мелких фич, от параллельной обработки файлов до поддержки стандартного входа.

    Такие дела.


    А, ну и стоит упомянуть ещё две вещи:


    1. Наш подход с полузависимыми типами не обязательно нежизнеспособен. Мы могли бы, например, вызывать каждый обработчик не на каждый байт, а на каждые 16-32 килобайта (по размеру кэша L1). Нетрудно подсчитать, что для стоимости вызова функций в 7 наносекунд, времени работы в районе секунды и размере файла в 1.8 гигабайт это дало бы оверхед в 0.4 мс, или 0.04%. Но тогда бы нам не пришлось играться с Template Haskell!
    2. Наша реализация всё равно не является полным эквивалентом wc, кое-что она делает по-другому. Например, статистика подсчёта символов не поддерживает кодировки, отличные от UTF-8 или ASCII, тогда как wc работает с произвольной локалью, делегируя всю работу по обработке символов glibc. Но так как наша реализация позволяет очень легко добавлять новые статистики, довольно просто добавить поддержку чего-то подобного, и, что самое главное — это не повлияет на, скажем, подсчёт количества строк или слов. Но про «не платить за то, что не используешь» я уже писал чуть выше.
    AdBlock похитил этот баннер, но баннеры не зубы — отрастут

    Подробнее
    Реклама

    Комментарии 34

      +1
      Всё хорошо за исключением одного, это не сравнение haskell и C, это сравнение двух различных реализаций, сходных на уровне входных и выходных данных, примерно как суперкар сравнивать с малолитражкой, обе машины, обе потребляют бензин и доставляют из пункта А в Б.
      Поэтому не совсем уместно сравнивать быстродействие. Если сделать одинаковые реализации, то этот вопрос становится актуальным. Но переписывать C код смысла нет, т.к. он всё равно не пойдёт в проект. А вот написать на haskell такую же реализацию как на C можно и тогда можно будет говорить о быстродействие.
        +6

        Только вот прям точно такую же реализацию у вас написать не получится, языки больно разные.


        Да и, на мой взгляд, тут важно как раз то, чтобы алгоритмы решали одну и ту же задачу. Если на одном языке получился суперкар, а на другом — малолитражка, то это всё же что-то и о языках говорит.

          0
          Автор говорит, что C версия выполняет много лишней работы при конкретных запросах, думаю она gnu реализация, может быть, старше самого haskell.

          Понятно, что один в один не получится, в принципе это справедливо для любого языка, но схожие подходы использовать можно.

          И по поводу суперкара на языке и малолитражки, хотя я уверен, что тут больше архитектурный подход, слабозависящий от самого языка, только реализация. Я как человек не знающий haskell, думаю за пару-тройку дней смогу написать на нем аналог wc, но я сомневаюсь, что о быстродействии вообще можно будет вести речь. И следуя вашей логике, можно будет сделать вывод, что haskell вообще не преспособлен к таким задачам, так как очень медленный.
            0
            Автор говорит, что C версия выполняет много лишней работы при конкретных запросах, думаю она gnu реализация, может быть, старше самого haskell.

            Да, GNU-реализация старая, но, судя по ченджлогам и комментам, её регулярно обновляют и поддерживают в актуальном состоянии.


            Кстати, довольно забавно — похоже, они таки почти погодки. Судя по всему, С-версия родилась году в 92-м, хаскель — примерно в 90-м, так что они более-менее сверстники.


            Понятно, что один в один не получится, в принципе это справедливо для любого языка, но схожие подходы использовать можно.
            И по поводу суперкара на языке и малолитражки, хотя я уверен, что тут больше архитектурный подход, слабозависящий от самого языка, только реализация.

            Это зависит от того, какие средства вам даёт язык. Например, если у вас в языке нет ленивых вычислений, то эмулировать их может быть очень больно. Если у вас в языке нет адекватного метапрограммирования, то эмулировать его тоже больно (если вообще можно). Или там, не знаю, рефлекшон какой-нибудь (кутешный moc появился не от хорошей жизни, средствами плюсов вы не сделаете его полноценную замену даже в C++20).


            Понятно, что на С почти наверное можно написать код, который даст такой же ассемблер, как и код на любом другом языке, но вопрос лишь в том, насколько это просто и поддерживаемо. А на написание кода на хаскеле, например, я потратил сильно меньше времени, чем на написание этой статьи.

        +4

        Классно но все равно мало понятно, как работают типы в хаскеле. На фразе "эт самодокументируемый код" после полной абракадабры поржал — надо лучше знать хаскель чтобы такое читать :) Пытался по ходу дела подумать как такое может выглядеть на каком-то С++/Rust но запутался что там происходит.

          0

          Я ещё когда читал статью в оригинале думал о том, что это, в принципе, можно и на Rust написать, только режимы статистик будет комбинировать больно из-за того, что в Rust повысить произвольное значение на уровень типов нельзя.

            0

            А где это в хаскель происходит и как, можете объяснить?

              +1

              Ну вот объединение режимов статистик. Прямо читается: обработка чанками комбинированной стратегией возможна только в том случае, если обе статистики могут работать с чанками:


              type family CombineCompTy a b where
                CombineCompTy 'Chunked 'Chunked = 'Chunked
                CombineCompTy _ _ = 'ByteOnly

              А далее CombineCompTy используется в инстансе, который реализует статистику для пары статистик. Собственно, как в заголовке и написано:


              instance (Statistic sa resa sta compa,
                        Statistic sb resb stb compb,
                        comp ~ CombineCompTy compa compb)
                     => Statistic (sa '::: sb) (resa ::: resb) (sta ::: stb) comp where

              Т. е. если sa и sb — статистики, поддерживающие режимы работы compa и compb соответственно, то sa '::: sb — комбинированная статистика — поддерживает режим CombineCompTy compa compb

                0

                Так а чем это отличается от трейтов?


                impl<Head: Stat, Tail: Stat> Stat for Cons<Head, Tail> {
                    type R = (Head::R, Tail::R);
                    fn result(&self) -> Self::R {
                        (self.h.result(), self.t.result())
                    }
                    fn step(&mut self, c: u8) {
                        self.h.step(c);
                        self.t.step(c);
                    }
                }
                
                impl<Head: ChunkedStat, Tail: ChunkedStat> ChunkedStat for Cons<Head, Tail> {
                    fn chunk_step(&mut self, s: &[u8]) {
                        self.h.chunk_step(s);
                        self.t.chunk_step(s);
                    }
                }
                
                fn main() {
                // тут будет только метод step()
                let mut stat = Cons::<CntBytes, Cons<CntWords, CntLines>>::default();
                // тут будет еще и chunk_step()
                let mut stat = Cons::<CntBytes, CntLines>::default();
                }
                

                Интересен момент как диспатчить рантайм значения в тип, но это в итоге было решено макросом, иначе происходит постоянный vtable и время замедляется. Или я что-то не понял?

                  0

                  Так в том-то и дело, что в коде на Haskell нет ChunkedStat, есть один тайпкласс (~трейт в Rust), параметризованный поддерживаемыми стратегиями вычисления. Вот есть у вас две статистики — как вы узнаете, какие стратегии поддерживает пара статистик?

                    0

                    Ну мой пример делает пару или тройку или сколько угодно статистик, и если одна из них не умеет в chunked то и у списка нету chunked метода.

                      0

                      Но в этом дизайне невозможно проверить, поддерживает ли список chunked метод в рантайме и в зависимости от этого выбрать разные пути исполнения

                        +1

                        если есть nightly то можно так


                        #![feature(specialization)]
                        
                        impl<T> Run for T
                        where
                            T: Stat,
                        {
                            default fn work(&mut self, s: &[u8]) {
                                println!("run steps!");
                                for c in s.iter() {
                                    self.step(*c);
                                }
                            }
                        }
                        
                        impl<T> Run for T
                        where
                            T: ChunkedStat,
                        {
                            fn work(&mut self, s: &[u8]) {
                                println!("run chunks!");
                                self.chunk_step(s);
                            }
                        }

                        и тогда в рантайме можно выбирать


                        use rand::Rng;
                        let cfg: bool = rand::thread_rng().gen();
                        println!("cfg {}", cfg);
                        let mut stat: Box<dyn Run> = if cfg {
                            Box::new(Cons::<CntBytes, Cons<CntWords, CntLines>>::default())
                        } else {
                            Box::new(Cons::<CntBytes, CntLines>::default())
                        };
                        stat.work("abc def\nghi jkl".as_bytes())

                        Но это немного не то конечно, хотя в чем разница до концы не ясно.

          0
          {-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleInstances #-}

          А можно обойтись без UndecidableInstances?

            0

            Неа: как минимум, комбинирующий инстанс для Statistic не получится написать. Проверка разрешимости инстансов требует, чтобы все переменные из констрейнтов упоминались в instance head (и даже ещё строже), а здесь это не так — compa и compb пропадает.

              0

              А можно решить эту проблему, отказавшись от fundeps и использовав вместо этого type families?

                0

                Отличное замечание! Тогда compa/compb действительно пропадут, и конкретно этого источника возможной неразрешимости не будет. Правда, ЕМНИП я все равно упирался в UndecidableInstances, даже когда сначала пытался с семействами типов это все сделать. Можно попробовать ещё разок.


                Но я бы не старался так уж избежать этого расширения всей ценой, в современном хаскеле это норма.

                  0

                  Ура, наконец дошли руки ковырнуть подход type families: похоже, он тоже требует UndecidableInstances. Если вы напишете класс как


                  class Statistic s where
                    type Res s = k | k -> s
                    type St s = k | k -> s
                    type Comp s :: StatCompTyOf
                    -- ...

                  и комбинирующий инстанс как


                  instance (Statistic sa, Statistic sb) => Statistic (sa '::: sb) where
                    type Res (sa '::: sb) = (Res sa ::: Res sb)
                    type St (sa '::: sb) = (St sa ::: St sb)
                    type Comp (sa '::: sb) = CombineCompTy (Comp sa) (Comp sb)

                  то компилятор скажет «неа»:


                      • Illegal nested type family application ‘CombineCompTy
                                                                  (Comp sa) (Comp sb)’
                        (Use UndecidableInstances to permit this)
                      • In the type instance declaration for ‘Comp’
                        In the instance declaration for ‘Statistic (sa ::: sb)’
                      |
                  113 |   type Comp (sa '::: sb) = CombineCompTy (Comp sa) (Comp sb)
                      |        ^^^^

                  Я сходу не придумал адекватного способа это обойти, но у меня не хватает понимания метатеории хаскелевской системы типов, чтобы доказать, что undecidable instances всегда нужны.

                    0

                    Так fundeps вроде в итоге остались, только внутри определения класса Statistic

                      0

                      Они тут на разрешимость не влияют (они и изначально не влияли на разрешимость, тащем, изначально скорее проблема была в том, как написан сам инстанс) и просто позволяют не писать везде s. Да и компилятор ругается не на них, а на то, как Comp используется внутри определения Comp.

                        0

                        Окей, я не понимаю тогда, на что именно жалуется компилятор. Откуда берётся неразрешимость инстансов?

                          0

                          У тайпчекера есть определённые чисто синтаксические правила (разрешения инстансов в первом случае и применения семейств типов во втором), которые гарантируют, что тайпчекинг всегда завершим. И вот здесь они нарушаются, хотя по факту тайпчекинг и здесь, конечно же, завершим.


                          Можно ли их расширить так, чтобы ухватить и эти случаи — я не знаю. Это надо брать соответствующие статьи с доказательством завершимости в оригинальном случае и смотреть, можно ли как-то что-то туда дополнительно натянуть.

              0

              Исходный код на Haskell всегда меня смущает. Я вроде игрался с ним. Читал великолепную "О Haskell по-человечески", но когда я читаю подобные статьи чувствую себя тупым, хотя вроде это не так. Вот на Kotlin не написал не строчки в своей жизни, но некоторые статьи заходят хорошо, а Haskell чудовищно наукоемок и наукообразен. Например слово "композабельный" затащило меня в пучину интернетов и только прочитав про императорских пингвинов я понял, что речь всего лишь о функции, которая может быть использована в композиции.

                0

                Проблемы отсутствия устоявшейся русскоязычной технической лексики. Фиг его знает, как правильно сказать «ticked»/«unticked», «promoted» и тому подобные слова, чтобы получившаяся фраза не выглядела нечитаемым адовым канцеляритом. Или вот «composable», да (но это не только к хаскелю относится, этот термин я и в ООП каком-нибудь часто видел).

                  –4
                  Большинство программ на Haskell — write-only. В этом его огромный минус
                    +4

                    Ну как… Тестировать проще, гарантий при механическом рефакторинге больше, средств сделать код модульным больше. Где ж там write-only?

                      +4

                      Так это и есть write-only: один раз написал и работает как часы, читать не надо.

                  –1

                  Чтобы результаты тестов скорости можно было сравнить, надо взять тесты корректности оригинальной версии wc, написать на хаскеле программу, которая все оригинальные тесты пройдет. То есть будет иметь точно такой же функционал. А только потом имеет смысл сравнивать скорость.
                  Иначе как в прошлый раз, так и сейчас, сравниваются яблоки с апельсинами

                    +2

                    Тут важнее не скорость сама по себе, а возможность легко не считать то, что не нужно.

                    +1

                    Запоздало прочитал статью. Очень круто, спасибо, пишите ещё. Самое забавное как выглядит


                    Кстати, это не тотальная функция: мы не обрабатываем случай пустого списка опций. С другой стороны, он у нас никогда и не возникнет, а использование вещей вроде NonEmpty усложнит изложение без всякой видимой выгоды.

                    В свете моего недавнего перевода. Посмеялся от души )

                      0

                      Спасибо!


                      Самое забавное как выглядит

                      А дело тут в том, что с NonEmpty надо брать uncons (который возвращает (a, Maybe (NonEmpty a)), потом паттерн-матчиться на этот Maybe… Короче, ИМХО, всё это становится очень неудобоваримым, особенно учитывая, что когнитивная нагрузка функции и так может показаться высокой. Вот, кстати, условный Vect (S n) был бы куда удобнее и полезнее, но увы.


                      Ну и так как это не библиотечный код, где полезны явно прописанные контракты, то я позволяю себе быть немножко ленивым.

                        0

                        А зчем там Maybe (NonEmpty a) если можно было просто [a]?

                          0

                          Ну, да, Maybe (NonEmpty a) изоморфно [a]. Но дело в том, что если вы хотите избежать необходимости отдельно обрабатывать [] (который не мапится ни в какой тип), то вам придётся проверять, пустой ли список перед рекурсивным вызовом, и доставать из него первый элемент, чтобы явно его передать в рекурсивный вызов, плюс (возможно пустой) хвост. То есть, вы руками делаете свой маленький NonEmpty.

                            0

                            Я просто не очень представляю зачем мне работать со списком как с maybe (nonEmpty). Обычно меня интересует только голова. А на хвосте если мне вдруг понадобиться я всегда могу вызвать parseNonEmpty, но скорее всего не понадобится.

                    Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.

                    Самое читаемое