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();
    }

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

#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;

}

-- p_sym - парсер, принимающий заданный символ
-- p_string - парсер, принимающий заданную строку
p_string = mapM p_sym -- mapM - стандартная функция, которой
-- достаточно только того, что p_sym - монада

HMV>Соответственно, many1 p = liftM2 ( p $ many p?

 
manyL :: (Functor p, MonadPlus p) => p a -> p [a]
manyL p = many (writing p) |>| reverse

{-# LANGUAGE BangPatterns#-}

module Main where

import System.Time
import System.IO
import Control.Monad
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Language
import Text.ParserCombinators.Parsec.Token
import qualified Data.ByteString.Char8 as B8

sign = liftM getSign (optionMaybe $ oneOf "-+")
       where getSign (Just '-') = -1.0
             getSign _ = 1.0

number = do
  s <- sign
  d <- liftM getN $ naturalOrFloat haskell
  return $! s * d
  where getN (Left i) = fromIntegral i
        getN (Right f) = f

sep = spaces >> return (+)

sumNumbers = spaces >> chainl number sep 0.0

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 = parse sumNumbers "" str
  putStrLn $ "Sum: " ++ show res
  return ()

benchmark = do
  str <- readFile "d:\\numbers.txt"
  (_, time) <- measured $ calculateSumm str
  putStrLn $ "Time: " ++ show time ++ " s."
  let thr = fromIntegral (length str) / time / 1048576.0;
  putStrLn $ "Throughput: " ++ show thr ++ " Mb/s"
  return ()

main = benchmark

sumNumbers = sn 0.0
    where sn !acc = do
            n <- optionMaybe number
            case n of { Just v -> sn (acc+v); _ -> return acc }

open ExtString;;

let (>>=) o f = match o with Some x -> f x | None -> None;;
let (>>) x f = f x;;

let digit c = c>='0' && c<='9';;

let p_pred p e =
  match Enum.peek e with 
  | Some c -> if p c then Enum.get e else None
  | None -> None;;
  
let manyf prs f s e =
  let rec frec v =
    match prs e with
    | Some c -> frec (f v c)
    | None -> v
  in frec s;;    
  
let rec many prs e = 
  match prs e with
  | Some _ -> many prs e
  | None -> ();;
  
let mkInt v c = v*10 + (int_of_char c) - 48;;
let mkFrac (fv,fr) c = (fv +. (float_of_int ((int_of_char c)-48))*.fr, fr*.0.1);;

let p_spaces = many (p_pred ((=) ' '));;
let p_sign e = match p_pred ((=) '-') e with Some _ -> -1.0 | None -> 1.0;;
let p_int e = Some (manyf (p_pred digit) mkInt 0 e);;
let p_dot = p_pred ((=) ',');;
let p_frac e = let (fv,fr) = manyf (p_pred digit) mkFrac (0.0, 0.1) e in Some fv;; 

let p_float e = 
  p_spaces e >> fun _ ->
  p_sign e >> fun s ->
  p_int e >>= fun n ->
  p_dot e >>= fun _ ->
  p_frac e >>= fun fr ->
  Some(s *. ((float_of_int n) +. fr));;  

let sumNumbers = manyf p_float (+.) 0.0;;

let measured f =
  let t0 = Unix.times() in
  let _ = f () in
  let t1 = Unix.times() in
  t1.Unix.tms_utime -. t0.Unix.tms_utime;;

let ic = open_in "e:\\numbers_large.txt" in
let str = input_line ic in
let t = measured (fun ()->print_float (sumNumbers (String.enum str))) in
close_in ic;
Printf.printf " %f s, %f MB/s" t ((float_of_int (String.length str)) /. t /. 1048576.0);;

#light

open System
type sc = System.Console

module Accumulator =
    type ('e, 'a) t = 'a * ('e -> 'a -> 'a)
    let create a f = (a, f)
    let append e (a, f) = (f e a, f)
    let get = fst
    
module Iterator =
    type 'a t = {buf: 'a array; len: int; pos: int}
    let iterate arr from = {buf=arr; len=Array.length arr; pos=from}
    let inline valid i = i.pos < i.len
    let current i = i.buf.(i.pos)
    let next i = {i with pos = i.pos+1}

let measured f =
    let sd = System.Diagnostics.Stopwatch()
    sd.Start()
    let res = f()
    sd.Stop()
    let time = double (sd.ElapsedMilliseconds) / 1000.0
    (res, time)
    
module A = Accumulator
module I = Iterator


type ('a, 's) ParseResult = Pass of 'a * 's | Fail
let pr_map f = function Pass (a, s) -> Pass(f a, s) | _ -> Fail

type ('a, 's) Parser = 's -> ('a, 's) ParseResult
let p_map f p = p >> (pr_map f)

let p_take s = if I.valid s then Pass(I.current s, I.next s) else Fail

let p_pred f = p_take >> function Pass(a, _) as ok when f a -> ok | _ -> Fail

let p_sym c = p_pred ((=) c)

let p_sym2 a b = p_pred (fun c -> c=a || c = b)

let p_try p s = p s |> function Pass(a, s') -> Pass(Some(a), s') | _ -> Pass(None, s)

let (<|>) p1 p2 s = p1 s |> function Pass(_, _) as ok -> ok | _ -> p2 s

let many p ac =
    let rec m acc s = match p s with Pass(a', s') -> m (A.append a' acc) s' | _ -> Pass(acc, s)
    m ac
    
let skipmany p =
    let rec m s = match p s with Pass(_, s') -> m s'| _ -> Pass((), s)
    m
    
let fconst a = fun _ -> a

type ParseMonad() =
    member x.Delay p = p ()
    member x.Return a = fun s -> Pass(a, s)
    member x.Bind(p, f) = p >> function Pass(a', s') -> (f a') s' | _ -> Fail
    member x.Let(a, f) = f a
    member x.Zero() = fconst Fail
    
let parse = ParseMonad()

let many1 p acc =
  parse {  let! r1 = p
           let! r2 = many p (A.append r1 acc)
           return r2
  }
  
let isDigit c = c >= 48uy && c <= 57uy
let digitToInt c = int (c - 48uy)
let digit = p_map digitToInt (p_pred isDigit)

let intAcc = A.create 0.0 (fun e a -> double e + a * 10.0)

let intPart = p_map A.get (many1 digit intAcc)

let frAcc = A.create (0.1, 0.0) (fun e (m, a) -> (m*0.1, a + m * double e))

let fracPartImpl = p_map (A.get >> snd) (many1 digit frAcc)

let sign = p_map (function Some(45uy) -> -1.0 | _ -> 1.0) (p_try (p_sym2 45uy 43uy))

let dot = p_map (fconst ()) (p_sym2 46uy 44uy)

let spaces = skipmany (p_sym 32uy)

let fracPart =
 parse { do! dot
         let! r = fracPartImpl
         return r
       }
       
let exponent = 
  parse { do! p_map ignore (p_sym2 101uy 69uy)
          let! r = intPart
          return 10.0 ** double r
        }
        
let fromOption a = function Some x -> x | _ -> a

let number =
  let fmay = fromOption 0.0
  parse { do! spaces
          let! s = sign
          let! i = p_try intPart
          let! f = p_try fracPart
          let! exp = p_map (fromOption 1.0) (p_try exponent)
          match (i, f) with
            | (None, None) -> return! (fconst Fail)
            | _ -> return (exp * s * (fmay i + fmay f))
  }
  
let manyNumbers iter () = iter |> p_map (A.get) (many number (A.create 0.0 (+)))

let benchMark() =
    let str = IO.File.ReadAllBytes @"d:\numbers_large.txt"
    let i = I.iterate str 0
    let (res, time) = measured (manyNumbers i)
    match res with
        | Pass(sum, _) -> 
            let thr = double (Array.length str) / 1048576.0 / time
            sc.WriteLine("Sum: {0}; Time: {1} s", sum, time)
            sc.WriteLine("Throughput: {0} Mb/s", thr)
        | _ -> sc.WriteLine "Fail"

do
    sc.WriteLine "Here I go"
    benchMark()
    sc.ReadKey() |> ignore

exception Noparse;;

let reader s = 
  let len = String.length s and pos = ref 0 in
  fun p ->
    if !pos>=len then raise Noparse else
    let c = s.[!pos] in
    if p c then (incr pos; c) else raise Noparse;;

let digit c = c>='0' && c<='9';;

let manyf prs f s r =
  let cv = ref s in
  try let rec frec v = cv := v; frec (f v (prs r)) in frec s
  with Noparse -> !cv;;  
  
let many prs r = 
  try let rec frec () = let _ = prs r in frec () in frec ()
  with Noparse->();;    
  
let mkInt v c = v*10 + (int_of_char c) - 48;;
let mkFrac (fv,fr) c = (fv +. (float_of_int ((int_of_char c)-48))*.fr, fr*.0.1);;

let p_pred p r = r p;;
let p_spaces = many (p_pred ((=) ' '));;
let p_sign r = try let _ = p_pred ((=) '-') r in (-1.0) with Noparse -> 1.0;;
let p_int = manyf (p_pred digit) mkInt 0;;
let p_dot = p_pred ((=) ',');;
let p_frac r = let (fv,fr) = manyf (p_pred digit) mkFrac (0.0, 0.1) r in fv;; 

let p_float r = 
  let _ = p_spaces r in
  let s = p_sign r in
  let n = p_int r in
  let _ = p_dot r in
  let fr = p_frac r in
  s *. ((float_of_int n) +. fr);;  

let sumNumbers = manyf p_float (+.) 0.0;;

let measured f =
  let t0 = Unix.times() in
  let _ = f () in
  let t1 = Unix.times() in
  t1.Unix.tms_utime -. t0.Unix.tms_utime;;

let ic = open_in "e:\\numbers_large.txt" in
let str = input_line ic in
let t = measured (fun ()->print_float (sumNumbers (reader str))) in
close_in ic;
Printf.printf " %f s, %f MB/s" t ((float_of_int (String.length str)) /. t /. 1048576.0);;

    // The result of a parse consists of a value and the unconsumed input.
    public class Result<TInput, TValue>
    {
        public readonly TValue Value;
        public readonly TInput Rest;
        public Result(TValue value, TInput rest) { Value = value; Rest = rest; }
    }

    // A Parser is a delegate which takes an input and returns a result.
    public delegate Result<TInput, TValue> Parser<TInput, TValue>(TInput input);

    public static class ParserCombinatorExtensions
    {
        public static Parser<TInput, TValue> OR<TInput, TValue>(this Parser<TInput, TValue> parser1, Parser<TInput, TValue> parser2)
        {
            return input => parser1(input) ?? parser2(input);
        }

        public static Parser<TInput, TValue2> AND<TInput, TValue1, TValue2>(this Parser<TInput, TValue1> parser1, Parser<TInput, TValue2> parser2)
        {
            return input => parser2(parser1(input).Rest);
        }
    }

    // Expose some operations on the Parser type using Extension methods.
    public static class ParserCombinatorsMonad
    {
        // By providing Select, Where and SelecMany methods on Parser<TInput,TValue> we make the 
        // C# Query Expression syntax available for manipulating Parsers.  
        public static Parser<TInput, TValue> Where<TInput, TValue>(this Parser<TInput, TValue> parser, Func<TValue, bool> pred)
        {
            return input =>
            {
                var res = parser(input);
                if (res == null || !pred(res.Value)) return null;
                return res;
            };
        }
        public static Parser<TInput, TValue2> Select<TInput, TValue, TValue2>(this Parser<TInput, TValue> parser, Func<TValue, TValue2> selector)
        {
            return input =>
            {
                var res = parser(input);
                if (res == null) return null;
                return new Result<TInput, TValue2>(selector(res.Value), res.Rest);
            };
        }
        public static Parser<TInput, TValue2> SelectMany<TInput, TValue, TIntermediate, TValue2>(this Parser<TInput, TValue> parser, Func<TValue, Parser<TInput, TIntermediate>> selector, Func<TValue, TIntermediate, TValue2> projector)
        {
            return input =>
            {
                var res = parser(input);
                if (res == null) return null;
                var val = res.Value;
                var res2 = selector(val)(res.Rest);
                if (res2 == null) return null;
                return new Result<TInput, TValue2>(projector(val, res2.Value), res2.Rest);
            };
        }
    }

    // Contains all the basic parsers that are independent of return type.
    public abstract class Parsers<TInput>
    {
        public Parser<TInput, TValue> Succeed<TValue>(TValue value)
        {
            return input => new Result<TInput, TValue>(value, input);
        }
        public Parser<TInput, TValue[]> Rep<TValue>(Parser<TInput, TValue> parser)
        {
            return Rep1(parser).OR(Succeed(new TValue[0]));
        }
        public Parser<TInput, TValue[]> Rep1<TValue>(Parser<TInput, TValue> parser)
        {
            return from x in parser
                   from xs in Rep(parser)
                   select (new[] { x }).Concat(xs).ToArray();
        }
    }

    // Contains a few parsers that parse characters from an input stream
    public abstract class CharParsers<TInput> : Parsers<TInput>
    {
        public abstract Parser<TInput, char> AnyChar { get; }
        public Parser<TInput, char> Char(char ch) { return from c in AnyChar where c == ch select c; }
        public Parser<TInput, char> Char(Predicate<char> pred) { return from c in AnyChar where pred(c) select c; }
    }

public abstract class DoubleParser<TInput> : CharParsers<TInput>
{
    public Parser<TInput, double> Number;
    public Parser<TInput, char[]> Whitespace;

    protected DoubleParser()
    {
        Whitespace = Rep(Char(' ').OR(Char('\t').OR(Char('\n')).OR(Char('\r'))));
        Number = from ws in Whitespace
                 let Digit = from c in Char(char.IsDigit) select int.Parse(c.ToString())
                 let Dot = Char('.').OR(Char(','))
                 let Sign = (from c in Char('+') select 1).OR(from c in Char('-') select -1)
                 let IntPart = from ws_ in Whitespace
                               from ds in Rep1(Digit)
                               select ds.FoldRightI(0, (i, d, acc) => acc + d*(int)Math.Pow(10, i))
                 let FracPart = from dt in Dot
                                from ds in Rep1(Digit)
                                select ds.FoldLeftI(0.0, (i, d, acc) => acc + d*Math.Pow(0.1, i))
                 let Expn = from c in Char('E').OR(Char('e'))
                            from s in Sign
                            from i in IntPart
                            select Math.Pow(10, s*i)
                 from s in Sign.OR(Default(1))
                 from i in IntPart
                 from f in FracPart.OR(Default(0.0))
                 from e in Expn.OR(Default(1.0))
                 select s * (i + f) * e;
    }

    public IEnumerable<double> Stream(TInput src)
    {
        var s = src;
        var res = Number(s);
        while (res != null)
        {
            yield return res.Value;
            res = Number(res.Rest);
        }
    }

    public Parser<TInput, T> Default<T>(T val)
    {
        return input => new Result<TInput, T>(val, input);
    }
}

public struct StringList
{
    private readonly int _cursor;
    private readonly string _s;

    public StringList(string s)
    {
        _s = s;
        _cursor = 0;
    }

    private StringList(string s, int c)
    {
        _s = s;
        _cursor = c;
    }

    public bool NonNil
    {
        get { return _cursor < _s.Length; }
    }

    public char Head
    {
        get { return _s[_cursor]; }
    }

    public StringList Tail
    {
        get { return new StringList(_s, _cursor + 1); }
    }
}

public static class Helper
{
    public static RT FoldRightI<T, RT>(this T[] arr, RT acc, Func<int, T, RT, RT> f)
    {
        var _acc = acc;
        var len = arr.Length - 1;
        for (var i = 0; i < arr.Length; i++)
            _acc = f(len - i, arr[i], _acc);
        return _acc;
    }

    public static RT FoldLeftI<T, RT>(this T[] arr, RT acc, Func<int, T, RT, RT> f)
    {
        var _acc = acc;
        for (var i = 0; i < arr.Length; i++)
            _acc = f(i + 1, arr[i], _acc);
        return _acc;
    }
}

public class DoubleParserFromIterator : DoubleParser<StringList>
{
    public override Parser<StringList, char> AnyChar
    {
        get
        {
            return input => input.NonNil
                                ?
                                    new Result<StringList, char>(input.Head, input.Tail)
                                :
                                    null;
        }
    }
}

internal class Program
{
    private static void Main()
    {
        var str = File.ReadAllText(@"c:\numbers_large.txt");
        
        var parser = new DoubleParserFromIterator();

        var sw = new Stopwatch();
        sw.Start();

        var sum = parser.Stream(new StringList(str)).Sum();

        sw.Stop();

        Console.WriteLine(str.Length/1024.0/1024.0/(sw.ElapsedMilliseconds/1000.0));
        Console.WriteLine(sum);
    }
}

    class Program
    {
        static void Main(string[] args)
        {
            Func<char, Parser<char, char>> symbol = s => Parsers.Satisfy((char c) => c == s);
            Func<string, Parser<char, char>> anyOf = symbols => Parsers.Satisfy((char c) => symbols.Contains(c));

            var digit = Parsers.Satisfy((char c) => c >= '0' && c <= '9');
            var digitValue = from c in digit select (long)c - '0';
            var dot = anyOf(",.");
            var minus = symbol('-');
            var space = anyOf(" \n");

            var integer = Parsers.Fold1Many1(digitValue, (s, i) => 10 * s + i);

            var fraction =
                from d in Parsers.FoldMany1(digitValue, (Tuple<long, int> acc, long i) => new Tuple<long, int>(10 * acc.First + i, acc.Second + 1), () => new Tuple<long, int>(0, 0))
                select d.First / (Math.Pow(10, d.Second));

            var sign = Parsers.Optional(from _ in minus select -1.0, 1.0);

            var exp = Parsers.Optional(
                from _ in anyOf("eE")
                from s in sign
                from i in integer
                select Math.Pow(10, i * s), 1);

            var real =
                from s in sign
                from i in integer
                from d in dot
                from f in fraction
                from e in exp
                select (i + f) * s * e;

            var realNumberSum = Parsers.Fold1Many1(
                    from r in real from _ in space select r,
                (f, s) => f + s);

            using (var fs = File.OpenText(@"C:\numbers_large.txt"))
            {
                DateTime dt = DateTime.Now;
                var sum = realNumberSum(new StreamEnumerator<char>(GetFileContentBlock(fs)));
                Console.WriteLine(sum.Output);
                Console.WriteLine(DateTime.Now - dt);
            }
        }

        static IEnumerable<char> GetFileContentBlock(StreamReader sr)
        {
            int size = 65536;
            char[] buf = new char[size];
            int actual;
            do
            {
                actual = sr.ReadBlock(buf, 0, size);
                for (int i = 0; i < actual; ++i)
                    yield return buf[i];
            } while (actual == size);
        }
    }

    public delegate Result<TInput, TOutput> Parser<TInput, TOutput>(EnumeratorEx<TInput> input);

    public static class Parsers
    {
        public static Parser<TSymbol, TSymbol> Satisfy<TSymbol>(Func<TSymbol,bool> predicate)
        {
            return input =>
                !input.IsValid ?
                new Result<TSymbol, TSymbol>(input) :
                    predicate(input.Head) ?
                    new Result<TSymbol, TSymbol>(input.Head, input.GetTail()) :
                    new Result<TSymbol, TSymbol>(input);
        }

        public static Parser<TInput, TOutput> FoldMany<TInput, TParsed, TOutput>(Parser<TInput, TParsed> parser, Func<TOutput, TParsed, TOutput> accumulator, Func<TOutput> seed)
        {
            return input =>
            {
                TOutput accumulated = seed();
                Result<TInput, TParsed> result;
                var curInput = input;
                while ((result = parser(curInput)).Success)
                {
                    accumulated = accumulator(accumulated, result.Output);
                    curInput = result.Remaining;
                }
                return new Result<TInput, TOutput>(accumulated, curInput);
            };
        }

        public static Parser<TInput, LinkedList<TOutput>> Many<TInput, TOutput>(Parser<TInput, TOutput> parser)
        {
            return FoldMany(parser, (LinkedList<TOutput> all, TOutput i) => { all.AddLast(i); return all; }, () => new LinkedList<TOutput>());
        }


        public static Parser<TInput, LinkedList<TOutput>> Many1<TInput, TOutput>(Parser<TInput, TOutput> parser)
        {
            Func<LinkedList<TOutput>,TOutput,LinkedList<TOutput>> car = (LinkedList<TOutput> list, TOutput elem) => {list.AddFirst(elem) ; return list;};

            return from p in parser
                   from rest in Many(parser)
                   select car(rest, p);
        }

        public static Parser<TInput, TOutput> FoldMany1<TInput, TParsed, TOutput>(Parser<TInput, TParsed> parser, Func<TOutput, TParsed, TOutput> accumulator, Func<TOutput> seed)
        {
            return from p in parser
                   from all in FoldMany(parser, accumulator, () => accumulator(seed(), p))
                   select all;
        }

        public static Parser<TInput, TOutput> Fold1Many1<TInput, TOutput>(Parser<TInput, TOutput> parser, Func<TOutput, TOutput, TOutput> accumulator)
        {
            return from p in parser
                   from all in FoldMany(parser, accumulator, () => p)
                   select all;
        }

        public static Parser<TInput, TOutput> Optional<TInput, TOutput>(Parser<TInput, TOutput> parser, TOutput defaultValue)
        {
            return input =>
            {
                if (!input.IsValid)
                    return new Result<TInput, TOutput>(defaultValue, input);
                var input1 = new RollbackableEnumerator<TInput>(input);
                var result1 = parser(input1);
                return result1.Success ?
                    result1 :
                    new Result<TInput, TOutput>(defaultValue, input1.GetMemorized());
            };
        }

        public static Parser<TInput, TOutput> Choise<TInput, TOutput>(params Parser<TInput, TOutput>[] parsers)
        {
            return input =>
            {
                var result1 = new Result<TInput, TOutput>(default(TOutput), input);
                var input1 = new RollbackableEnumerator<TInput>(input);
                foreach (var parser in parsers)
                {
                    result1 = parser(input1);
                    if (result1.Success)
                        break;
                    input1 = new RollbackableEnumerator<TInput>(input1.GetMemorized());
                }
                return result1;
            };
        }

        public static Parser<TInput, TOutput> All<TInput, TParsed, TOutput>(Func<TOutput, TParsed, TOutput> accumulator, Func<TOutput> seed, params Parser<TInput, TParsed>[] parsers)
        {
            return input =>
            {
                var result = seed();
                var input1 = input;
                foreach (var parser in parsers)
                {
                    var result1 = parser(input1);
                    if (!result1.Success)
                        return new Result<TInput, TOutput>(input1);
                    result = accumulator(result, result1.Output);
                    input1 = result1.Remaining;
                }
                return new Result<TInput, TOutput>(result, input1);
            };
        }

    public static class ParserExtension
    {
        public static Parser<TInput, TOutput> Select<TInput, TIntermediate, TOutput>(this Parser<TInput, TIntermediate> parser, Func<TIntermediate, TOutput> selector)
        {
            return input =>
            {
                var rez = parser(input);
                return rez.Success ?
                    new Result<TInput, TOutput>(selector(rez.Output), rez.Remaining) :
                    new Result<TInput, TOutput>(rez.Remaining);
            };
        }

        public static Parser<TInput, TOutput> SelectMany<TInput, TIntermediate, TIntermediate2, TOutput>
            (this Parser<TInput, TIntermediate> parser, Func<TIntermediate, Parser<TInput, TIntermediate2>> selector, Func<TIntermediate, TIntermediate2, TOutput> projector)
        {
            return input =>
            {
                var rez1 = parser(input);
                if (!(rez1.Success))
                    return new Result<TInput, TOutput>(rez1.Remaining);
                var rez2 = selector(rez1.Output)(rez1.Remaining);
                return rez2.Success ?
                    new Result<TInput, TOutput>(projector(rez1.Output, rez2.Output), rez2.Remaining) :
                    new Result<TInput, TOutput>(rez2.Remaining);
            };
        }
    }

    public struct Tuple<T1, T2>
    {
        T1 first;
        T2 second;

        public Tuple(T1 first, T2 second)
        {
            this.first = first;
            this.second = second;
        }

        public T1 First
        {
            get { return first; }
        }

        public T2 Second
        {
            get { return second; }
        }
    }

    public struct Result<TInput, TOutput>
    {
        EnumeratorEx<TInput> remaining;
        TOutput output;
        bool success;

        public Result(TOutput output, EnumeratorEx<TInput> remaining, bool success)
        {
            this.output = output;
            this.remaining = remaining;
            this.success = success;
        }

        public Result(TOutput output, EnumeratorEx<TInput> remaining)
            : this(output, remaining, true)
        {
        }

        public Result(EnumeratorEx<TInput> remaining)
            :this(default(TOutput),remaining,false)
        {
        }

        public bool Success
        {
            get { return success; }
        }

        public EnumeratorEx<TInput> Remaining
        {
            get { return remaining; }
        }

        public TOutput Output
        {
            get { return output; }
        }
    }

    public abstract class EnumeratorEx<T> : IDisposable
    {
        public abstract bool IsValid
        {
            get;
        }

        public abstract EnumeratorEx<T> GetTail();

        public abstract T Head
        {
            get;
        }

        public abstract void Dispose();
    }

    public class StreamEnumerator<T> : EnumeratorEx<T>
    {
        IEnumerator<T> enumerator;
        bool isValid;

        public StreamEnumerator(IEnumerable<T> enumerable)
        {
            this.enumerator = enumerable.GetEnumerator();
            this.isValid = this.enumerator.MoveNext();
        }

        public override bool IsValid
        {
            get { return isValid; }
        }

        public override EnumeratorEx<T> GetTail()
        {
            if (!isValid)
                throw new InvalidOperationException("Cannot move non valid stream enumerator");
            this.isValid = enumerator.MoveNext();
            return this;
        }

        public override T Head
        {
            get
            {
                if (!isValid)
                    throw new InvalidOperationException("Cannot return head for non valid stream enumerator");
                return enumerator.Current;
            }
        }

        #region IDisposable Members

        public override void Dispose()
        {
            enumerator.Dispose();
        }

        #endregion
    }

    public class RollbackableEnumerator<T> : EnumeratorEx<T>
    {
        class RolledBackEnmerator : EnumeratorEx<T>
        {
            Queue<T> log;
            EnumeratorEx<T> real;

            public RolledBackEnmerator(Queue<T> log, EnumeratorEx<T> real)
            {
                this.log = log;
                this.real = real;
            }

            public override bool IsValid
            {
                get { return true; }
            }

            public override EnumeratorEx<T> GetTail()
            {
                if (log.Count == 0)
                    return real;
                log.Dequeue();
                return this;
            }

            public override T Head
            {
                get { return log.Peek(); }
            }

            public override void Dispose()
            {
                real.Dispose();
            }
        }

        EnumeratorEx<T> real;
        Queue<T> log;

        public RollbackableEnumerator(EnumeratorEx<T> from)
        {
            this.real = from;
            this.log = new Queue<T>();
        }

        public EnumeratorEx<T> GetMemorized()
        {
            return log.Count > 0 ?
                new RolledBackEnmerator(log, real) :
                real;
        }

        public override bool IsValid
        {
            get { return real.IsValid; }
        }

        public override EnumeratorEx<T> GetTail()
        {
            log.Enqueue(real.Head);
            return real = real.GetTail();
        }

        public override T Head
        {
            get { return real.Head; }
        }

        public override void Dispose()
        {
            real.Dispose();
        }
    }

let Digit = from c in Char(char.IsDigit) select int.Parse(c.ToString())

let Digit = from c in Char(char.IsDigit) select c

    public static int ToDigit(this char argument)
    {
        switch (argument)
        {
            case '0': return 0;
            case '1': return 1;
            case '2': return 2;
            case '3': return 3;
            case '4': return 4;
            case '5': return 5;
            case '6': return 6;
            case '7': return 7;
            case '8': return 8;
            case '9': return 9;
        }
        throw new ArgumentException(argument.ToString());
    }

(int)с - '0'

    public Parser<TInput, IEnumerable<TValue>> Rep<TValue>(Parser<TInput, TValue> parser)
    {
        return input =>
        {
            var result = parser(input);

            var values = new List<TValue>();
            
            while (result != null) {
                input = result.Rest;
                values.Add(result.Value);
                result = parser(input);
            }

            return new Result<TInput, IEnumerable<TValue>>(values, input);
        };
        //return Rep1(parser).OR(Succeed(new TValue[0]));
    }

:- set_prolog_flag(float_format,'%.15g').
:- set_prolog_flag(optimize, true).

integer(I) -->
        digit(D0),
        digits(D),
        { number_chars(I, [D0|D])
        }.

digits([D|T]) -->
        digit(D), !,
        digits(T).
digits([]) -->
        [].

digit(D) -->
        [D],
        { code_type(D, digit)
        }.


float(F) -->
    (   "-", {Sign = -1}
    ;   "", {Sign = 1}
    ), !,
    integer(N),
    ",",
    integer(D),
    {F is Sign * (N + D / 10^(ceiling(log10(D))))
    }.

sum(S, Total) -->
    float(F1), !,
    " ",
    { S1 is S + F1},
    sum(S1, Total).
sum(Total, Total) -->
    [].


go1 :-
    phrase_from_file(sum(0, S),'numbers_large.txt', [buffer_size(16384)]),
    writeln(S).

print sum((float(x.replace(',','.')) for x in open("numbers_large.txt").read().split(" ") if x))

FR>print sum((float(x.replace(',','.')) for x in open("numbers_large.txt").read().split(" ") if x))
FR>

Console.WriteLine(Array.ConvertAll(File.ReadAllText(@"c:\numbers_large.txt").Split(' '), value => double.Parse(value)).Sum());

sum(C, G, A, I) :-
        float(D, A, B), !,
        B=[32|E],
        F is C+D,
        H=E,
        sum(F, G, H, I).
sum(A, A, B, B).

digit(A, [A|C], B) :-
        code_type(A, digit),
        B=C.

digits([A|C], B, E) :-
        digit(A, B, D), !,
        digits(C, D, E).
digits([], A, A).

integer(C, A, F) :-
        digit(D, A, B),
        digits(E, B, G),
        number_chars(C, [D|E]),
        F=G.

go1 :-
        phrase_from_file(sum(0, A), 'numbers_large.txt', [buffer_size(16384)]),
        writeln(A).

float(H, A, K) :-
        (   A=[45|B],
            C= -1,
            D=B
        ;   E=A,
            C=1,
            D=E
        ), !,
        integer(I, D, F),
        F=[44|G],
        integer(J, G, L),
        H is C* (I+J/10^ceiling(log10(J))),
        K=L.

bracketed open close action = do
    open
    x <- action
    close
    return x

FR>>>print sum((float(x.replace(',','.')) for x in open("numbers_large.txt").read().split(" ") if x))
FR>>>

sumFile :: String -> IO Double
sumFile = fmap (foldl' (+) 0.0 . fmap read . words) . readFile

 ?- catch((writeln('Test1...'),
|    throw(exc('Ups..')),
|    writeln('Unachievable..')), exc(E), writeln(E)).
Test1...
Ups..
E = 'Ups..'.

X> ?- catch((writeln('Test1...'),
X>|    throw(exc('Ups..')),
X>|    writeln('Unachievable..')), exc(E), writeln(E)).
X>Test1...
X>Ups..
X>E = 'Ups..'.
X>

import Control.Monad.State
import Control.Monad.List

type P a = StateT String [] a

pitem :: P Char
pitem = do
    cs <- get
    case cs of
        (c:cs) -> do
            put cs
            return c
        _ -> mzero

psat p = do
    x <- pitem
    if p x then return x else mzero

pchar c = psat (==c)

pmany p = pmany1 p `mplus` return []
pmany1 p = do
    x <- p
    xs <- pmany p
    return $ x:xs

bracketed open close action = do
    open
    x <- action
    close
    return x

braced = bracketed (pchar '(') (pchar ')')

balanced = do {pmany (braced balanced); return ()}

T>import Control.Monad.State
T>import Control.Monad.List

T>type P a = StateT String [] a

T>pitem :: P Char
T>pitem = do
T>    cs <- get
T>    case cs of
T>        (c:cs) -> do
T>            put cs
T>            return c
T>        _ -> mzero

T>psat p = do
T>    x <- pitem
T>    if p x then return x else mzero

T>pchar c = psat (==c)

T>pmany p = pmany1 p `mplus` return []
T>pmany1 p = do
T>    x <- p
T>    xs <- pmany p
T>    return $ x:xs

T>bracketed open close action = do
T>    open
T>    x <- action
T>    close
T>    return x

T>braced = bracketed (pchar '(') (pchar ')')

T>balanced = do {pmany (braced balanced); return ()}
T>

many(What) -->
    What,
    many(What).
many(_) --> [].

bracketed(Open, Close, What) -->
    Open,
    What,
    Close.

braced(What) --> bracketed("(", ")", What).
braced(What) --> bracketed("{", "}", What).
braced(What) --> bracketed("[", "]", What).

balanced -->
    many(braced(balanced)).

test :-
    phrase(balanced, "[](){[{()}]}"),
    phrase(balanced, "[[[()]]]({}{{[]}})[{}]()[]"),
    \+ phrase(balanced, "[[[()]]]({[}{{[]}})[{}]()[]").

?- test.
true .

from System.Diagnostics import Stopwatch

s = Stopwatch()
s.Start()

print sum((float(value.replace(',','.')) for value in open("c:\\numbers_large.txt").read().split(" ") if value))

s.Stop()

print s.ElapsedMilliseconds

T>И какая у этого производительность?

:- set_prolog_flag(float_format,'%.15g').

many1(What, [H | T]) -->
    call(What, H), !,
    many1(What, T).
many1(_, []) --> [].


integer(I) -->
        many1(digit, [D|DD]),
    { number_chars(I, [D|DD])
        }.

digit(D) -->
        [D],
        { code_type(D, digit)
        }.


float(F) -->
    (   "-", {Sign = -1}
    ;   "", {Sign = 1}
    ), !,
    integer(N),
    ",",
    integer(D),
    {F is Sign * (N + D / 10^(ceiling(log10(D))))
    }.

sum(S, Total) -->
    float(F1), !,
    " ",
    { S1 is S + F1},
    sum(S1, Total).
sum(Total, Total) -->
    [].

go1 :-
    phrase_from_file(sum(0, S),'numbers_large.txt', [buffer_size(16384)]),
    writeln(S).

Console.WriteLine((from value in File.ReadAllText(@"c:\numbers_large.txt").Split(' ') where value !=  "" select double.Parse(value)).Sum());

public static class StringHelper
{
    public static IEnumerable<string> AsyncSplit(this string value, char delimiter)
    {
        int start = 0;
        int index = value.IndexOf(delimiter, start);

        while (index != -1)
        {
            yield return value.Substring(start, index - start);
            start = index + 1;
            index = value.IndexOf(delimiter, start);
        }
    }
}

Fatal error: exception Invalid_argument("String.create")

let (>>=) o f = match o with Some x -> f x | None -> None;;
let (>>) x f = f x;;

let digit c = c>='0' && c<='9';;

let p_pred p e =
  match Stream.peek e with 
  | Some c when p c -> Stream.junk e; Some c
  | _ -> None;;
  
let manyf prs f s e =
  let rec frec v =
    match prs e with
    | Some c -> frec (f v c)
    | None -> v
  in frec s;;    
  
let rec many prs e = 
  match prs e with
  | Some _ -> many prs e
  | None -> ();;
  
let mkInt v c = v*10 + (int_of_char c) - 48;;
let mkFrac (fv,fr) c = (fv +. (float_of_int ((int_of_char c)-48))*.fr, fr*.0.1);;

let p_spaces = many (p_pred ((=) ' '));;
let p_sign e = match p_pred ((=) '-') e with Some _ -> -1.0 | None -> 1.0;;
let p_int e = Some (manyf (p_pred digit) mkInt 0 e);;
let p_dot = p_pred ((=) ',');;
let p_frac e = let (fv,fr) = manyf (p_pred digit) mkFrac (0.0, 0.1) e in Some fv;; 

let p_float e = 
  p_spaces e >> fun _ ->
  p_sign e >> fun s ->
  p_int e >>= fun n ->
  p_dot e >>= fun _ ->
  p_frac e >>= fun fr ->
  Some(s *. ((float_of_int n) +. fr));;  

let sumNumbers = manyf p_float (+.) 0.0;;

let measured f =
  let t0 = Unix.times() in
  let _ = f () in
  let t1 = Unix.times() in
  t1.Unix.tms_utime -. t0.Unix.tms_utime;;

let ic = open_in "numbers_large.txt" in
let str = Stream.of_channel ic in
let t = measured (fun ()->print_float (sumNumbers  str)) in
close_in ic;
Printf.printf " %f s, %f MB/s\n" t ((float_of_int (Stream.count str)) /. t /. 1048576.0);;

{-# LANGUAGE BangPatterns  #-}

module Main where

import System.Time
import System.IO
import Data.List

sumFile :: String -> IO Double
sumFile = fmap (foldl' (+) 0.0 . fmap read . words) . readFile

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)

main = do
   (s, time) <- measured $ sumFile "d:\\numbers_large.txt"
   putStrLn $ "Sum: " ++ show s
   putStrLn $ "Time: " ++ show time ++ " s."

# let rec sum = parser [<'n; r=sum>] -> n + r | [<>] -> 0;;
val sum : int Stream.t -> int = <fun>
# sum [<'1; '2; '3>];;
- : int = 6
#

S>-- p_sym - парсер, принимающий заданный символ
S>-- p_string - парсер, принимающий заданную строку
S>p_string = mapM p_sym -- mapM - стандартная функция, которой
S>-- достаточно только того, что p_sym - монада
S>

using Nemerle.Peg;
using System;
using System.Collections.Generic;
using System.Console;

[PegGrammar(
  start,
  grammar 
  {
    any             = ['\u0000'..'\uFFFF'];
    s     : void    = ' ';
    dot   : void    = '.';
    num   : double  = '-'? ['0'..'9']+ dot ['0'..'9']+ s;
    start : double  = num+ !any;
  }
)]
public partial class Parser
{
  _str : string;
  public this(str : string) { _str = str; }

  // Генератор парсеров не рассчитан на дурные битодробильные тесты, а рассчитан на генерацию AST.
  // По сему помещает результат циклических правил в список, что не здорово для подобных задач.
  start(nums : List[double]) : double
  {
    mutable res = 0.0;
    foreach (n in nums)
      res += n;
    res
  }

  num(minus : NToken, num1 : NToken, num2 : NToken) : double
  {
    if (minus.IsEmpty)
      ToLong(num1) + GetFrac(num2)
    else
      -1.0 * (ToLong(num1) + GetFrac(num2));
  }

  // Рукопашная реализация так как стандартная дотнетная функция на таких скоростях выглядит тормозом.
  ToLong(num : NToken) : long 
  {
    mutable res : long = 0;
    
    for (mutable i = num.StartPos; i < num.EndPos; i++)
      res = res * 10 + (_str[i] - '0' : int);
      
    res
  }

  GetFrac(num : NToken) : double
  {
    mutable res : double = 0.0;
    
    for (mutable i = num.EndPos - 1; i >= num.StartPos; i--)
      res = res * 0.1 + (_str[i] - '0' : int);
      
    res * 0.1
  }
}

module Program
{
  Main() : void
  {
    def data    = IO.File.ReadAllText(@"e:\temp\numbers_large.txt");
    def parser  = Parser(data);
    def timer   = Diagnostics.Stopwatch.StartNew();
    
    match (parser.Parse(data))
    {
      | Some(res) => WriteLine($"Result: $res  Test took: $(timer.Elapsed)");
      | None      => WriteLine("Parsing failed");
    }
  }
}

VD>Хуже кода для столь простой задачи придумать просто невозможно .

{- 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

whitespaces <- whitespace+
sign <- ('-' / '+')?
int <- [0-9]+
dot <- '.' / ','
frac <- dot int
exp <- ('e' / 'E') sign int
num <- int / (int frac) / frac
float <- sign num exp? whitespaces
floats <- float*

VD>Причем не самопалами с объемом кода на 5 экранов, а самым что ни наесть штатным образом.

{- 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

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