diff --git a/src/morphodict/MkMorphodict.hs b/src/morphodict/MkMorphodict.hs index f0390cda..b262d917 100644 --- a/src/morphodict/MkMorphodict.hs +++ b/src/morphodict/MkMorphodict.hs @@ -67,6 +67,7 @@ mkMorphoDict :: MDEnv -> ([String],[String]) mkMorphoDict env = unzip $ map splitRule $ + findCompounds $ nameFunctions $ mergeRules $ concatMap findRules cats @@ -76,7 +77,7 @@ mkMorphoDict env = cats = nub [c | (c,(_,_,_)) <- M.assocs (config env)] findRules cat = [ - ([snd (head lin), showCId c], (c, op : appSig ints (map snd lin))) | + ([snd (lin !! head ints), showCId c], (c, op : appSig ints (map snd lin))) | --- head ints is the base form in smart paradigms f <- functionsByCat (pgf env) cat, lin <- tabularLinearizes (pgf env) (lang env) (mkApp f []), -- [[(String, String)]] Just (c,op,ints) <- [M.lookup cat (config env)] @@ -96,6 +97,22 @@ mkMorphoDict env = renames fls = [(mkFun (init f ++ [show i,last f]),l) | (i,(f,l)) <- zip [1..] fls] + findCompounds = getCompounds . sortOn cat_revstem + + cat_revstem (_,(cat,_:stem:_)) = (cat,reverse stem) + revstem = snd . cat_revstem + + getCompounds fls = case fls of + fl : fls2 -> case span (\x -> isPrefixOf (revstem fl) (revstem x)) fls2 of + ([],_) -> fl : getCompounds fls2 + (fls1,fls3) -> fl : map (markCompound fl) fls1 ++ getCompounds fls3 + _ -> [] + + markCompound (f,(_,l)) fl1@(f1,(c1,l1)) = case and [isPrefixOf w w1 | (w,w1) <- zip l l1] of + True -> markWith fl1 ["compound",f] + False -> markWith fl1 ["notcompound",f] + + markWith (f,(c,l)) xs = (f,(c,l ++ [";","--"] ++ xs)) mkFun = quoteIf . concat . intersperse "_" quoteIf s = case s of diff --git a/src/morphodict/MorphoDictSwe.config b/src/morphodict/MorphoDictSwe.config index 15923b5f..e3773d89 100644 --- a/src/morphodict/MorphoDictSwe.config +++ b/src/morphodict/MorphoDictSwe.config @@ -1,5 +1,5 @@ N : N mkN 0 2 4 6 -A : A mkA 0 2 4 8 10 +A : A mkA 0 2 4 10 12 V : V mkV 6 0 4 2 8 10 V2 : V mkV 6 0 4 2 8 10 Adv : Adv mkAdv 0