vshabanov

{-# LANGUAGE OverloadedStrings, BangPatterns, FlexibleInstances #-}
-- | Тупейший (и, надеюсь, быстрый) парсер xml -> теги.
--
-- Выдает где-то от 40МБ/сек (а где-то и 80 и 200)
--
-- Все теги и атрибуты возвращаются в lowercase (строка меняется INPLACE,
-- для уменьшения числа аллокаций и фрагментации)
--
-- После профилирования выяснилось,
-- что TagSoup отжирает 75% памяти и >50% времени. Более того,

vshabanov

Core was generated by `/tank/riak-1.3.1/erts-5.9.1/bin/beam.smp -K true -A 64 -W w -- -root /tank/riak'.
Program terminated with signal 11, Segmentation fault.
#0  0x00007f162547fa30 in MurmurHash64A(void const*, int, unsigned int) ()
   from /tank/riak-1.3.1/lib/eleveldb-1.3.0/priv/eleveldb.so

(gdb) bt
#0  0x00007f162547fa30 in MurmurHash64A(void const*, int, unsigned int) ()
   from /tank/riak-1.3.1/lib/eleveldb-1.3.0/priv/eleveldb.so
#1  0x00007f162547833c in leveldb::(anonymous namespace)::BloomFilterPolicy2::CreateFilter(leveldb::Slice const*, int, std::string*) const ()
   from /tank/riak-1.3.1/lib/eleveldb-1.3.0/priv/eleveldb.so

vshabanov

/home/volodya/bazqux/reader +RTS -N6 -T -A64m -I0 -M15G -Sgc.log 
    Alloc    Copied     Live    GC    GC     TOT     TOT  Page Flts
    bytes     bytes     bytes  user  elap    user    elap
...
200204936  11385664 4462860272  0.07  0.01  220.24  712.22    0    0  (Gen:  0)
125044568  14154720 4466342848  0.05  0.01  220.38  713.54    0    0  (Gen:  0)
143563344  28353016 4485534120  0.11  0.02  220.58  713.96    0    0  (Gen:  0)
111524720 2261676760 2517120536  3.88  0.65  224.51  714.69    0    0  (Gen:  1)
213486648  31853152 2547183104  0.14  0.02  224.86  715.83    0    0  (Gen:  0)
148648432  25858736 2548365176  0.11  0.02  225.08  716.76    0    0  (Gen:  0)

vshabanov

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T
import qualified Data.Aeson as JSON
import Data.Char
import Text.Printf
import Control.Monad

-- wget http://www.unicode.org/Public/9.0.0/ucd/UnicodeData.txt

vshabanov

{-# LANGUAGE GADTs #-}

class Clickable a where
    click :: a -> String
class Renderable a where
    render :: a -> String

data Interface a where
    Clickable :: Clickable a => Interface a
    Renderable :: Renderable a => Interface a

vshabanov

resolveA :: DNSCache -> String -> IO (Either T.Text HostAddress)
resolveA c d =
    handle Left $ checkDomain id d $ fmap errorStr $ resolve c (B.pack d)

resolveCachedA :: DNSCache -> String -> IO (Maybe (Either T.Text HostAddress))
resolveCachedA c d =
    handle (Just . Left) $ checkDomain Just d $ fmap (fmap errorStr) $ resolveCache c (B.pack d)

handle f a = a `E.catch` handleError f

vshabanov

{-# LANGUAGE GHC2021, LambdaCase, PatternSynonyms, RecordWildCards,
             ViewPatterns, OverloadedStrings, GADTs, NoMonoLocalBinds,
             UnboxedTuples, MagicHash #-}

{-# OPTIONS_GHC -O2 -fspec-constr-count=100 -fllvm #-}
-- need at least 8 to completely remove all allocations
-- (I don't know what change lead to it)

{-# OPTIONS_GHC -Wall -Wno-gadt-mono-local-binds -Wno-type-defaults #-}