Disclaimer: всего лишь собственные наблюдения, захотелось поделиться. Может кому интересно будет.
Haskell заработал репутацию чрезвычайно тормознутого языка. Ленивость, добавляющая свой оверхед к любой операции, все значения в хипе, иммутабельность значений — все это, конечно, скорости не добавляет.
Понадобилось решить одну задачку, связанную с разбором гибридного бинарно-текстового формата. Поскольку смысл этого решения — всего лишь упрощение собственной повседневной работы, позволил себе повыбирать средство реализации. В том числе и по быстродействию. И в велосипедописании потренироваться. И вот тут Haskell очень сильно удивил.
Поскольку много кода дублировать на разных языках ой как не хотелось, тест сведен к простой задаче: парсинг потока double'ов. В качестве источника данных — текстовый файл, содержащий 5 000 000 чисел в диапазоне [-10 000; 10 000], размером около 82 мб (сгенереный таким вот C#-кодом):
static void Main(string[] args)
{
using (Stream stm = new FileStream(@"d:\numbers_large.txt", FileMode.Create))
{
TextWriter wr = new StreamWriter(stm);
System.Random r = new System.Random();
for (int i = 0; i < 5000000; i++)
{
double d=10000*r.NextDouble() * (r.NextDouble() > 0.7 ? -1.0 : 1.0);
wr.Write("{0} ", d);
}
wr.Flush();
}
А вот код парсера на Haskell. Код наверняка далек от идеального и избыточен (но и писался он не только для такой простой задачи). Кстати, если кто из здешних знатоков Haskell найдет что покритиковать — буду грейтфул
Компилятор GHC 6.8.2, компиляция, естественно, с оптимизацией:
ghc --make -O2 -funfolding-use-threshold=64 hsparser.hs
{-# LANGUAGE NoMonomorphismRestriction, FlexibleInstances,
MultiParamTypeClasses, FunctionalDependencies,
BangPatterns #-}
module Main (main) where
import System.Time
import Control.Monad
import Control.Monad.Trans
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Char
import Data.Int
import Data.Maybe
{- результат работы любого парсера:
Pass - успешное завершение,
s - остаток входного потока, a - полученное значение
Fail - неуспешное, s - остаток входного потока в позиции, где случилась ошибка
-}
data ParseResult s a = Pass s a | Fail s --deriving Show
instance Show a => Show (ParseResult s a) where
show (Pass _ a) = "Pass: " ++ show a
show _ = "Fail"
{- чтобы удобным образом применять преобразования
к полученному от парсера результату, объявим
ParseResult инстансом класса Functor
это даст нам функцию fmap c типом
ParseResult s a -> (a -> b) -> ParseResult s b
-}
instance Functor (ParseResult s) where
fmap f (Pass s a) = Pass s (f a)
fmap _ (Fail s) = Fail s
{- для того, чтобы на вход парсера можно было подавать
не только список, но и любой другой тип, например, ByteString,
определим класс типов ParserInput
-}
class ParserInput s e | s -> e where
p_get :: s -> ParseResult s e
{- и его инстансы для списка и ByteString -}
instance ParserInput [e] e where
p_get (h:t) = Pass t h
p_get s = Fail s
instance ParserInput B8.ByteString Char where
p_get s | B8.null s = Fail s
| otherwise = Pass (B8.tail s) (B8.head s)
instance ParserInput BL8.ByteString Char where
p_get s | BL8.null s = Fail s
| otherwise = Pass (BL8.tail s) (BL8.head s)
{- базовый тип парсера - функция, принимающая как аргумент
входной поток символов, и возвращающая ParseResult,
т.е. при успехе - остаток входного потока и результат,
при неуспехе - только остаток потока после ошибки
-}
newtype Parser s a = Parser { runParser :: s -> ParseResult s a }
{- Parser тоже объявим инстансом класса Functor -}
instance Functor (Parser s) where
fmap f (Parser p) = Parser $ fmap f . p
{- теперь начинаются монадические заморочки. В принципе, можно
обойтись и без них, но так зато получаем удобную форму
записи с использованием do-notation, а также бонус
в виде некоторых стандартных функций, работающих с монадами
-}
{- return a - возвращает парсер, который независимо от
входного потока завершается успешно и возвращает значение a
bind (>>=) - связывает два парсера в последовательное выполнение,
при неуспехе первого второй не вызывается. Как это выглядит
с использованием do-нотации - будет ниже.
-}
instance Monad (Parser s) where
return a = Parser $ \s -> Pass s a
(Parser p) >>= f = Parser $ \s ->
case p s of
Pass s' a' -> runParser (f a') s'
Fail s -> Fail s
{- Объявив парсер инстансом класса MonadPlus, получаем
две функции: mzero - парсер, который в любом случае
завершается с неуспехом, и mplus - альтернатива,
т.е. при неуспехе первого парсера отрабатывает второй
-}
instance MonadPlus (Parser s) where
mzero = Parser $ \s -> Fail s
(Parser p1) `mplus` (Parser p2) = Parser $ \s ->
case p1 s of { ok@(Pass _ _) -> ok; _ -> p2 s }
{- теперь вот еще какая штука: часто результат разбора в
виде строки/списка нам вообще не нужен, а нужен результат
некоей операции над этим списком - типа fold'а
Можно определить тип парсера, который сразу же
по мере обработки потока будет эту свертку выполнять.
Получается нечто очень похожее на стандартную монаду
Writer, но Writer требует, чтобы хранящееся в нем
значение было моноидом - что-то у меня не получилось
с этим обходиться -}
newtype WriterP w m a = WriterP { runWriterP :: w -> m (w, a) }
instance Monad m => Monad (WriterP w m) where
return a = WriterP $ \w -> return (w, a)
(WriterP p) >>= f = WriterP $ \w -> do
(w', a') <- p w
runWriterP (f a') w'
instance MonadTrans (WriterP w) where
lift m = WriterP $ \w -> do { a <- m; return (w, a) }
instance MonadPlus m => MonadPlus (WriterP w m) where
mzero = lift mzero
(WriterP p1) `mplus` (WriterP p2) = WriterP $ \w -> p1 w `mplus` p2 w
instance Functor m => Functor (WriterP w m) where
fmap f (WriterP p) = WriterP $ \w -> fmap (apply2 f) (p w)
where apply2 f (a, b) = (a, f b)
{- базовый "кирпичик", на основе которого строятся все парсеры -
парсер, который берет 1 символ из входного потока,
и успешно завершается, если поток не пуст.
Чтобы компилятор мог сам вывести тип - Parser или WriterP Parser,
определим класс типов ParseMonad -}
class Monad m => ParseMonad m a where
p_take :: m a
instance ParserInput s a => ParseMonad (Parser s) a where
p_take = Parser p_get
instance ParseMonad m a => ParseMonad (WriterP w m) a where
p_take = lift p_take
{- теперь на основе базового "кирпичика" чуть более полезные
строительные блоки -}
{- парсер на основе предиката - завершается успешно,
если символ из входного потока соответствует условию -}
p_pred :: (ParseMonad p a, MonadPlus p) => (a -> Bool) -> p a
p_pred f = do
a <- p_take
if f a then return a else mzero
{- парсер, принимающий только заданный символ -}
p_sym :: (Eq a, ParseMonad p a, MonadPlus p) => a -> p a
p_sym c = p_pred (==c)
{- и, для удобства, его вариация - один из двух символов -}
p_sym2 :: (Eq a, ParseMonad p a, MonadPlus p) => a -> a -> p a
p_sym2 c d = p_pred $ \a -> a == c || a == d
{- парсер, принимающий заданную строку -}
p_string = mapM p_sym
{- p_try - парсер, который всегда завершается успешно,
но возвращает не a, a Maybe a -}
p_try :: (Functor p, MonadPlus p) => p a -> p (Maybe a)
p_try p = fmap Just p `mplus` return Nothing
{- many - множественный (0 или более) повтор парсера
не возвращает значения, предполагается что
парсером будет WriterP -}
many :: (Functor p, MonadPlus p) => p a -> p ()
many p = mn
where mn = do
a <- p_try p
case a of {Just _ -> mn; _ -> return () }
{- 1 или более -}
many1 p = p >> many p
{-- ============================================
теперь вернемся к WriterP. Чтобы иметь возможность
накапливать значение по мере парсинга, определим
класс типов - накопителей
-- ============================================ -}
class Accumulator a e | a -> e where
a_empty :: a
a_append :: e -> a -> a
{- и его инстанс для списка, чтобы иметь возможность
получать результат парсера в виде списка -}
instance Accumulator [e] e where
a_empty = []
a_append = (:)
{- теперь трансформер для парсера, который преобразует
его в аккумулирующий -}
writing :: (Accumulator w a, Monad p) => p a -> WriterP w p ()
writing p = WriterP $ \(!w) -> do
a <- p
return (a_append a w, ())
{- и для случаев, если отдельный тип-аккумулятор
заводить не хочется -}
writingF :: Monad p => (a -> w -> w) -> p a -> WriterP w p ()
writingF f p = WriterP $ \(!w) -> do
a <- p
return (f a w, ())
{- обратный трансформер - аккумулирующий парсер
в возвращающий накопленное значение -}
wrRun :: (Monad p, Functor p) => WriterP w p x -> w -> p w
wrRun (WriterP p) w = fmap fst $ p w
{- и еще одна вариация -}
wrUnwrap :: (Functor p, Accumulator w e) => WriterP w p x -> (w -> a) -> p a
wrUnwrap (WriterP p) f = fmap (f . fst) $ p a_empty
(|>|) = wrUnwrap
{- =========================================
теперь ближе к предмету - пусть пока
это будут числа -}
{- digit - парсер, принимающий символы от '0' до '9'
и возвращающий уже их числовое значение -}
digit = fmap digitToInt $ p_pred isDigit
spaces = many $ p_pred isSpace
dot = p_sym2 ',' '.'
{- sign - парсер, опционально принимающий знаки '+' и '-',
возвращающий Double-множитель, -1.0 для '-',
1.0 в противном случае -}
sign = fmap getSign $ p_try (p_sym2 '-' '+')
where getSign (Just '-') = -1.0
getSign _ = 1.0
data IntAcc = IntAcc { getInt :: {-# UNPACK #-} !Double }
instance Accumulator IntAcc Int where
a_empty = IntAcc 0.0
a_append i (IntAcc a) = IntAcc $ a * 10.0 + fromIntegral i
{- intPart - разбор целой части -}
intPart = many1 (writing digit) |>| getInt
{- а если не хочется городить отдельный тип для аккумулятора -
можно так -}
intPart2 = wrRun (many1 (writingF intFold digit)) 0.0
where intFold e !i = i * 10.0 + fromIntegral e
data FrAcc = FrAcc { mult :: {-# UNPACK #-} !Double,
getFrac :: {-# UNPACK #-} !Double }
instance Accumulator FrAcc Int where
a_empty = FrAcc 0.1 0.0
a_append i (FrAcc m a) = FrAcc (m * 0.1) (a + m * fromIntegral i)
{- fracPart - разбор дробной части -}
fracPart = dot >> many1 (writing digit) |>| getFrac
{- expn - разбор экспоненты -}
expn = do
p_sym2 'e' 'E'
s <- sign
i <- intPart
return $ 10 ** (s * i)
{- number - разбор числового значения -}
number = do
spaces
s <- sign
i <- p_try intPart
f <- p_try fracPart
exp <- liftM (fromMaybe 1.0) $ p_try expn
case (i, f) of
(Nothing, Nothing) -> mzero
_ -> return $! exp * s * (fmay i + fmay f)
where fmay = fromMaybe 0.0
data Sum a = Sum {getSum :: {-# UNPACK #-} !a}
instance Num a => Accumulator (Sum a) a where
a_empty = Sum $ fromIntegral 0
a_append e (Sum a) = Sum $ e + a
sumNumbers = many (writing number) |>| getSum
{- выполнение IO action c замером времени -}
measured :: IO a -> IO (a, Double)
measured act = do
let getSeconds t = fromIntegral (tdPicosec t) / 1000000000000.0 + fromIntegral (tdSec t)
start <- getClockTime
!r <- act
end <- getClockTime
let delta = getSeconds $ diffClockTimes end start
return (r, delta)
calculateSumm str = do
let res = runParser sumNumbers str
putStrLn $ "Sum: " ++ show res
return ()
benchMark = do
str <- B8.readFile "d:\\numbers_large.txt"
(_, time) <- measured $ calculateSumm str
putStrLn $ "Time: " ++ show time ++ " s."
let thr = fromIntegral (B8.length str) / time / 1048576.0;
putStrLn $ "Throughput: " ++ show thr ++ " Mb/s"
return ()
main = benchMark
От имени C++ выступает boost::spirit, как инструмент, дающий в руки C++-программиста абстракции, примерно идентичные ФП-шным комбинаторным парсерам. Вот такой (все просто, т.к. используется встроенный спиритовский парсер real_p)
#include <boost/spirit.hpp>
#include <iostream>
struct SumAction
{
SumAction(double &d) : value(d) {}
void operator () (double c ) const
{
value += c;
}
mutable double &value;
};
void Run()
{
HANDLE h = CreateFile(L"d:\\numbers_large.txt", GENERIC_READ, FILE_SHARE_READ,
NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
DWORD sz = GetFileSize(h, NULL);
char * p = new char [sz+4];
ZeroMemory(p, sz+4);
DWORD read;
ReadFile(h, p, sz, &read, NULL);
// спиритовский real_p не понимает запятую
for(unsigned int i=0; i<sz; i++) if(p[i]==',') p[i]='.';
LARGE_INTEGER li;
QueryPerformanceFrequency(&li);
double freq = double(li.QuadPart);
QueryPerformanceCounter(&li);
double start = double(li.QuadPart);
double sum = 0.0;
parse(p, +real_p[SumAction(sum)], space_p);
QueryPerformanceCounter(&li);
double end = double(li.QuadPart);
double time = (end - start) / freq;
std::cout << "Sum: " << sum << std::endl;
std::cout << "Time: " << time << " s." << std::endl;
CloseHandle(h);
delete [] p;
}
Компилятор — Visual C++ Express 2008. Все опции оптимизации на максимум — Full optimization, inline any suitable, favor fast code, link-time code generation.
Результат работы (Core2Duo 3,12 ггц)
Haskell — ~1.56 секунды. 52,5 мб/сек.
C++ (spirit) — ~1.88 секунды. 44 мб/сек. Правда, если рантайм сменить с DLL на статически линкуемый, то ~1.65 секунды.
Вот так. Haskell вровень с C++, и даже опережает.
Хотел привести еще то же решение на F#, но если не скатываться к традиционному императивному решению (а зачем тогда F# нужен?), быстрее 10 сек. пока не получилось.
Вообще, старичок двухплюсатый все равно на высоте — если все переписать вручную (код тупой, приводить не охота), отрабатывает за 0,45 сек. Только ведь в более сложном случае вероятность такого ручного расписывания невелика.
Ну а по выразительности c Haskell сложно что-либо сравнивать. Монады — вообще чертовски интересная штука. Этакий очень абстрактный интерфейс, который, если придумать, как пристегнуть к своей задаче, дает бонус в виде стандартных библиотечных функций, ориентированных на работу с монадами. Например, из кода выше:
-- p_sym - парсер, принимающий заданный символ
-- p_string - парсер, принимающий заданную строку
p_string = mapM p_sym -- mapM - стандартная функция, которой
-- достаточно только того, что p_sym - монада