[haskell] Профилирование или CAF жрёт время
От: Tonal- Россия www.promsoft.ru
Дата: 26.01.10 11:04
Оценка: 1 (1)
Есть небольшенькая программка. Конвертор данных из одного формата в другой. Пока написано только чтение в память и распечатка разных сведений.
Запустил на реальных данных — окончания не дождался хотя файлы вроде не очень большие. Самый большой — 50мб. остальные существенно меньше.
В системном мониторе задача сразу же занимает 50% проца (у меня 2 ядра) быстро отжирает 15гб памяти и в таком состоянии замерзает на длительное время.

Чтоб понять что происходит обкоцал в одном месте список (take 1000) и скомпилировал с профиляцией (-prof, -auto-all, -O3).
После ожидания получил такой профиль:
    total time  =      611.60 secs   (30580 ticks @ 20 ms)
    total alloc = 156,043,505,640 bytes  (excludes profiling overheads)

COST CENTRE                    MODULE               %time %alloc

fillSymp2Remedy                Main                  97.3   98.0
hh                             Main                   1.5    0.0
...
                                                                                               individual    inherited
COST CENTRE              MODULE                                               no.    entries  %time %alloc   %time %alloc

MAIN                     MAIN                                                   1           0   0.0    0.0   100.0  100.0
 main                    Main                                                 234          13   0.1    0.1     1.3    2.1
...
  s2rBySymptom           Main                                                 272     1787990   0.1    0.0     0.1    0.0
  symp_2rem_len          BaseType                                             267           2   0.0    0.0     0.0    0.0
  fillChapter            Main                                                 255           5   0.0    0.0     0.3    0.2
   treeSymptom           Main                                                 261      137846   0.1    0.0     0.3    0.2
    createSymptom        Main                                                 279       34222   0.1    0.1     0.2    0.2
     fillSymp2Remedy     Main                                                 280      136888   0.1    0.1     0.1    0.1
      hh                 Main                                                 281       68444   0.0    0.0     0.0    0.0
    groupFrom            Main                                                 278       68406   0.0    0.0     0.0    0.0
...
  rowSympByCapter        Main                                                 248      248580   0.0    0.0     0.0    0.0
...
 CAF                     Main                                                 228          51   0.0    0.0    98.7   97.9
...
  treeSymptom            Main                                                 262        4022   0.0    0.0    98.7   97.9
   createSymptom         Main                                                 268        1002   0.0    0.0    98.7   97.9
    fillSymp2Remedy      Main                                                 269    38590678  97.2   97.9    98.7   97.9
     createSymp2Remedy   Main                                                 276       25380   0.0    0.0     0.0    0.0
     toEnum_aZb          BaseType                                             275         723   0.0    0.0     0.0    0.0
     fromEnum_aZf        BaseType                                             273        1446   0.0    0.0     0.0    0.0
     hh                  Main                                                 270    38562524   1.5    0.0     1.5    0.0
   groupFrom             Main                                                 266        2001   0.0    0.0     0.0    0.0
...

Возникает несколько вопрсов/непоняток:
1. Что за вызовы CAF?
2. Откуда такие дикие цифры во второй строке с fillSymp2Remedy)
3. Как с этим всем бороться.
Вроде вот проблемное место (немного сократил):
type PVS = [[Strings]]

fillChapter :: PSV -> [PSV] -> St.State Ids BT.Chapters
fillChapter cPsv sPsvs = do
  ids <- St.get
  chapters <- zipWithM createChapter [succ . cid $ ids..] $ zip cPsv sPsvs
  return chapters
  where
  createChapter i ([num, chapter], sPsv) = do
    ids <- St.get
    St.put ids{cid=i}
    let cnum = read num
    tree <- treeSymptom sPsv
    return BT.Chapter {BT.chapt_id=i, ..., BT.chapt_tree=tree}
  createChapter i (xs, sPsv) = error ("createChapter: "++ show xs)

treeSymptom :: PSV -> St.State Ids BT.ReposNode
treeSymptom psv = do
  ids <- St.get
  let psv2 = Trace.trace ("Re: " ++ (show . length $ psv)) . take 1000 $ psv -- Ограничиваем количество
  tree <- Tree.unfoldTreeM createSympTree $ zip [succ . sid $ ids..] psv2
  return tree
  where
  createSympTree rows = do
    let first = head rows
        [_, lv', _, _, _] = snd $ first
        lv = read lv' + 1
        child_rows = groupFrom ((== show lv) . head . tail . snd) $ tail rows
    symp <- createSymptom first
    return (symp, child_rows)

createSymptom :: (BT.SidType, [String]) -> St.State Ids BT.Symptom
createSymptom (i, [num, lv, _, cat, name]) = do
  ids <- St.get
  St.put ids{sid=i}
  let symp' = BT.Symptom {BT.symp_id=i, ..., BT.symp_2rem=nullSR}
      nullSR = []

  s2r' <- fillSymp2Remedy symp' num
  let symp = symp' {BT.symp_2rem=s2r}
      s2r = map (\s -> s{BT.s2r_symptom=symp}) s2r'
  return symp

fillSymp2Remedy :: BT.Symptom -> String -> St.State Ids BT.Symp2Remedies
fillSymp2Remedy sym str_snum = do
  ids <- St.get

  let BT.SympRadar snum = BT.symp_origin sym
      psv' = dropWhile ((snum <) . read . hh) . sr_psvs $ ids
      (psv, psvTail) = span ((str_snum ==) . hh) psv'

  if null psv then do
      return []
   else do
    St.put ids{sr_psvs=psvTail}
    srs <- zipWithM (createSymp2Remedy  sym) [succ . srid $ ids..] . head $ psv
    return srs
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.