Есть задачка сравнения 2х деревьев.
Деревья живут в текстовых файлах, каждое немногим меньше 200000 строк.
Написал с местной помошью сравнивалку — сравнивает два таких дерева, и выводит ветки в которых есть ненайденные подветки, и сами такие подветки.
Запустил на одном и том же файле — нашлись "ненайденные" строки, которых как бы не должно быть...

Теперь непонятно, как всё это отладить...
В том же С++ или Python-е я бы навтыкал везде отладочную печать, расставил асерты, и пусканулся под отладчиком (точки останова с условием и на вылете исключений рулят).

А как и что делать в ghc я пока не очень понимаю...
Может кто поможет/подскажет?..

Ну и конечно комментарии и советы приветствуются.

Вот проблемный код (diff_hash.hs):

import Data.Char
import Data.List
import qualified Data.Map as M
import Data.Monoid
import Data.Maybe
import Text.Printf
import Text.Regex.PCRE
import ShuraUtils

-- Выделение идентификатора из строки
str2name = re_replace . simpleIdent -- identWithType

-- идентификатор - часть строки до первой скобки
simpleIdent = strip . takeWhile (/='(')

-- идентификатор - часть строки до первой скобки + тип из последней (a, ...)
identWithType str = first ++ (getSmb $ latest end)
  where
    first = strip $ takeWhile (/='(') str
    end = groupFrom (=='(') str
    latest [] = ""
    latest xs = last xs
    getSmb (x:y:z:xs) | x == '(' && z == ',' = " (" ++ [y] ++ ")"
    getSmb xs = ""

-- замена
re_replace "" = ""
re_replace str = before ++ repl grp ++ re_replace after
  where
    (before, match, after, grp) = (
      str =~ regexp :: (String, String, String, [String]))
    repl [] = ""
    repl [xs] = fromJust $ lookup xs substsForIdent
    -- регулярное выражение для поиска места замены
    regexp = "(\\b" ++ sub substsForIdent ++ "\\b)\\.?"
      where sub = concat . intersperse "|" . map fst

-- список замен 
substsForIdent = [
  ("one am", "1 a.m."),
  ("two am", "2 a.m."),
  ("three am", "3 a.m."),
  ("four am", "4 a.m."),
  ("five am", "5 a.m."),
  ("six am", "6 a.m."),
  ("seven am", "7 a.m."),
  ("eight am", "8 a.m."),
  ("nine am", "9 a.m."),
  ("ten am", "10 a.m."),
  ("eleven am", "11 a.m."),
  ("twelve am", "12 a.m."),
  ("one pm", "1 p.m."),
  ("two pm", "2 p.m."),
  ("three pm", "3 p.m."),
  ("four pm", "4 p.m."),
  ("five pm", "5 p.m."),
  ("six pm", "6 p.m."),
  ("seven pm", "7 p.m."),
  ("eight pm", "8 p.m."),
  ("nine pm", "9 p.m."),
  ("ten pm", "10 p.m."),
  ("eleven pm", "11 p.m."),
  ("twelve pm", "12 p.m.")]

-- http://rsdn.ru/Forum/Message.aspx?mid=3240093&only=1
data ATree cont = ATree {
  lnum :: Int,     -- номер строки
  str :: String,   -- сама строка (без лидирующих пробелов)
  ident :: String, -- идентификатор
  subtree :: (cont (ATree cont))} --deriving (Show)

getString = str
getName = ident
getLNum = lnum
getNA x = (lnum x, str x)
getSub  = subtree

-- Представление дерева списками
type LTree = ATree []
lTree i a xs = ATree i a (str2name a) xs
lLeaf i a    = lTree i a []
lEmpty       = lLeaf 0 ""

-- Представление дерева мапами
type MTree = ATree (M.Map String)
mTree i a ms = ATree i a (str2name a) ms
mLeaf i a    = mTree i a M.empty
mEmpty       = mLeaf 0 ""

fromSub = ATree 0 "" ""

aunion (ATree i1 a1 n1 ms1) (ATree i2 a2 n2 ms2)
  | n1 /= n2  = error ("union not eq name: " ++ n1 ++ " " ++ n2)
  | i1 < i2   = ATree i1 a1 n1 ms
  | otherwise = ATree i2 a2 n2 ms
  where
    ms = ms1 `mappend` ms2

-- Перевод спискового дерева в мапное
l2mTree x@(ATree _ _ _ xs) = x{subtree=tomap xs}
  where
    tomap = M.fromListWith aunion . map (keyval getName . l2mTree)

-- Перевод списка строк в дерево списков
-- http://rsdn.ru/Forum/Message.aspx?mid=3240203&only=1
makeTrees = map constr . grp
  where
    -- разбиваем на группы, начинающиеся со строки без отступа
    grp = groupFrom' (not . isSpace . head . snd) createLost
    createLost x = (fst x, "(!)")
    -- в каждой из групп первую строчку используем для заголовка дерева
      -- а в оставшихся строках отрезаем первые два пробела и
      -- рекурсивно изготовляем из них список деревьев
    constr ((i, a) : xs) = lTree i a (makeTrees (map ctrSub xs))
    ctrSub (i, a) = (i, drop 2 a)

-- Фильтрация дерева списков оставляющая только дубли
-- http://rsdn.ru/Forum/Message.aspx?mid=3240203&only=1
onlyDubles lst x@(ATree _ _ n xs) =
  case (n `elem` lst, mapMaybe (onlyDubles (getLst xs)) xs) of
    (False, []) -> Nothing
    (_,     xxs) -> Just (x {subtree=xxs})
  where
    getLst = map head . filter len_gr_1 . group . sort . map getName

takeDubles = fromMaybe lEmpty . onlyDubles []

-- Фильтрация дерева списков оставляющая только ненайденные элементы
onlyNotFound ms x@(ATree _ _ n xs) = notFound $ M.lookup n $ subtree ms
  where
    notFound Nothing = Just x
    notFound (Just mt) = getXxs $ mapMaybe (onlyNotFound mt) xs 
    getXxs []  = Nothing
    getXxs xxs = Just (x {subtree=xxs})

takeNotFound :: MTree -> LTree -> LTree
takeNotFound mTree = 
  fromMaybe lEmpty . onlyNotFound (fromSub $ M.singleton "" mTree)

-- Перевод дерева списков в список строк
ltree2lst' pref x = showANode pref x : newXs x
  where
    newXs = concatMap (ltree2lst' (pref ++ "  ")) . subtree

showANode pref x = printf "%7d |%s %s" (lnum x) pref (str x)

ltree2lst (ATree 0 "" "" xs) = concatMap (ltree2lst' "") xs

prepRep = tail . zip [1..] . lines

mkRep = fromSub . makeTrees . prepRep

rep2map = l2mTree . mkRep

main = do
  dict_rep <- readFile "compl2008_wolec_part"
  --putStr $ unlines $ ltree2lst $ takeDubles $ mkRep dict_rep
  let mrep = rep2map dict_rep
  print $ M.size $ getSub mrep
  tst_rep <- readFile "compl2008_wolec_part"
  putStr $ unlines $ ltree2lst $ takeNotFound mrep $ mkRep tst_rep

Модуль с дополнительными утилитами:

module ShuraUtils (
  (>>>),
  lstrip, strip, len_gr_1, 
  sort_and_groupOn, sort_and_groupOn', sortOn, sortOn', groupOn,
  keyval, map2cmp, map2eq,
  groupFrom, groupFrom',
  fst3, snd3, third, dropFirst, dropThird
) where

import List

-- Оператор потока
x >>> f = f x

-- Убирание начальных пробелов
lstrip = dropWhile (==' ')
-- Убирание начальных и концевых пробелов
strip = reverse . lstrip . reverse . lstrip

-- Длиннна списка больше 1 
len_gr_1 = not . null . drop 1

-- Сортировка и группировка списков по ключу от BulatZiganshin
--http://gzip.rsdn.ru/forum/message/3235773.1.aspx
-- |Sort and Group list by function result
sort_and_groupOn  f  =  groupOn f . sortOn  f
sort_and_groupOn' f  =  groupOn f . sortOn' f

-- |Sort list by function result (use Schwarznegian transform)
sortOn  f  =  map snd . sortOn' fst . map (keyval f)

-- |Sort list by function result (don't use Schwarznegian transform!)
sortOn' f  =  sortBy (map2cmp f)

-- |Group list by function result
groupOn f  =  groupBy (map2eq f)

-- Utility functions for list operations
keyval  f x    =  (f x, x)             -- |Return pair containing computed key and original value
map2cmp f x y  =  (f x) `compare` (f y)-- |Converts "key_func" to "compare_func"
map2eq  f x y  =  (f x) == (f y)       -- |Converts "key_func" to "eq_func"

-- http://rsdn.ru/Forum/Message.aspx?mid=3240394&only=1
-- Группировка списка. 
-- Каждая группа начинается с элемента удовлетворяющему условию (crit).
-- Остальные члены группы условию не удовлетворяют
groupFrom crit [] = []
--groupFrom crit (x:xs) | not (crit x) = error "lost group head!!!"
groupFrom crit (x:xs) = 
  let (l1, l2) = break crit xs
  in  (x : l1) : groupFrom crit l2

-- Группировка с корректировкой
-- createEmpty - создание недостающего элемента например:
-- createEmpty x = (fst x, "(!)")
groupFrom' crit createLost [] = []
groupFrom' crit createLost (x:xs) = 
  let 
    (l1, l2) = break crit xs
    grp x l | not (crit x) = createLost x : x : l
    grp x l = x : l
  in grp x l1 : groupFrom' crit createLost l2

-- Работа с тройками
fst3 :: (a, b, c) -> a
fst3 (x, _, _) = x
snd3 :: (a, b, c) -> b
snd3 (_, x, _) = x
third :: (a, b, c) -> c
third (_, _, x) = x
dropThird :: (a, b, c) -> (a, b)
dropThird (x, y, _) = (x, y)
dropFirst :: (a, b, c) -> (b, c)
dropFirst (_, x, y) = (x, y)

Данные для теста: compl2008_wolec_part

Таки сумел найти ошибку!
Функция aunion должна выполнять глубокое слияние:

aunion (ATree i1 a1 n1 ms1) (ATree i2 a2 n2 ms2)
  | n1 /= n2  = error ("union not eq name: " ++ n1 ++ " " ++ n2)
  | i1 < i2   = ATree i1 a1 n1 ms
  | otherwise = ATree i2 a2 n2 ms
  where
    ms = M.unionWith aunion ms1 ms2

Помогло изучение возможностей ghci по отладке, а именно команды :break, :trace, :back.
Хотя отладочного вывода изрядно не хватает.

Здравствуйте, Tonal-, Вы писали:

T>А как и что делать в ghc я пока не очень понимаю...
T>Может кто поможет/подскажет?..

Но в GHCi недавно появился примитивный отладчик, может он тебе поможет?
Дополнительно я бы написал юнит-тесты и/или прогнал тесты QuickCheck для подозрительных функций, чтобы локализовать ошибку.

P.S. Длиннна — это чтобы наверняка?

С Уважением, Andir!

Здравствуйте, Tonal-, Вы писали:

T>Хотя отладочного вывода изрядно не хватает.

См. модуль Debug.Trace