diff options
| -rw-r--r-- | src/GF/Conversion/RemoveErasing.hs | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/src/GF/Conversion/RemoveErasing.hs b/src/GF/Conversion/RemoveErasing.hs index 8185e4f02..1dc2560fc 100644 --- a/src/GF/Conversion/RemoveErasing.hs +++ b/src/GF/Conversion/RemoveErasing.hs @@ -57,9 +57,11 @@ newRules grammar chart (NR (Rule (Abs _ cats _) _)) newRules grammar chart (NC newCat@(MCat cat lbls)) = do Rule (Abs _ args (Name fun profile)) (Cnc _ _ lins0) <- grammar ? cat - let lins = [ lin | lin@(Lin lbl _) <- lins0, - lbl `elem` lbls ] - argsInLin = listAssoc $ + lins <- selectLins lins0 lbls + -- let lins = [ lin | lin@(Lin lbl _) <- lins0, + -- lbl `elem` lbls ] + + let argsInLin = listAssoc $ map (\((n,c),l) -> (n, MCat c l)) $ groupPairs $ nubsort $ [ ((nr, cat), lbl) | @@ -86,6 +88,9 @@ newRules grammar chart (NC newCat@(MCat cat lbls)) guard $ all (not . null) argLbls return $ NR (Rule (Abs newCat newArgs newName) (Cnc lbls argLbls newLins)) +selectLins lins0 = mapM selectLbl + where selectLbl lbl = [ lin | lin@(Lin lbl' _) <- lins0, lbl == lbl' ] + prtNewName :: [Profile (SyntaxForest Fun)] -> [Profile (SyntaxForest Fun)] -> Name -> String prtNewName p p' n = prt p ++ " .o. " ++ prt p' ++ " : " ++ prt n |