diff options
| author | peb <peb@cs.chalmers.se> | 2006-03-21 06:18:03 +0000 |
|---|---|---|
| committer | peb <peb@cs.chalmers.se> | 2006-03-21 06:18:03 +0000 |
| commit | 6d13bb9e3c93634a20f810d04484a221c495f16f (patch) | |
| tree | c5677b3ebbef83b165ca3875c5b661368c5152f8 /src | |
| parent | ab8edebcee38edaf882c4ae99de7c2f06b59aa08 (diff) | |
fixed bug with variants in GF.Conversion.RemoveErasing
Diffstat (limited to 'src')
| -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 |