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

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

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

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

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


rmrkd0k9gjyumqz6fmjbxsooovi.png

Основная функция С-версии не влезла на 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

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).

Ладно. Что, если мы посчитаем и сл

© Habrahabr.ru