From 6d13bb9e3c93634a20f810d04484a221c495f16f Mon Sep 17 00:00:00 2001 From: peb Date: Tue, 21 Mar 2006 06:18:03 +0000 Subject: [PATCH] fixed bug with variants in GF.Conversion.RemoveErasing --- src/GF/Conversion/RemoveErasing.hs | 11 ++++++++--- 1 file 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