diff options
| author | bringert <bringert@cs.chalmers.se> | 2006-02-01 19:00:48 +0000 |
|---|---|---|
| committer | bringert <bringert@cs.chalmers.se> | 2006-02-01 19:00:48 +0000 |
| commit | bdf602b95c1deb816cd48eb44a4a0a782b6193ea (patch) | |
| tree | a9ee4952d9696dd08c561e17d7dd057b7e6d8aaf /src/GF/Speech | |
| parent | 8cd03874f6d048cd4512e2855a30254cdf66de65 (diff) | |
SRGS: add top-level rules for each GF category.
Diffstat (limited to 'src/GF/Speech')
| -rw-r--r-- | src/GF/Speech/PrSRGS.hs | 10 |
1 files changed, 9 insertions, 1 deletions
diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs index 6e445d41a..60c2ba8e7 100644 --- a/src/GF/Speech/PrSRGS.hs +++ b/src/GF/Speech/PrSRGS.hs @@ -57,13 +57,21 @@ prSrgsXml sisr (SRG{grammarName=name,startCat=start, ++ ". " ++ "Original start category: " ++ origStart), meta "generator" ("Grammatical Framework " ++ version ++ " (compiled " ++ today ++ ")")] - ++ map ruleToXML rs) + ++ topCatRules + ++ map ruleToXML rs) ruleToXML (SRGRule cat origCat alts) = rule (prCat cat) (comments ["Category " ++ origCat] ++ prRhs isList alts) where isList = "List" `isPrefixOf` origCat && length cs == 2 && isBase (cs!!0) && isCons (cs!!1) cs = sortNub [f | SRGAlt _ (Name f _) _ <- alts] prRhs isList rhss = [oneOf (map (mkProd sisr isList) rhss)] + -- externally visible rules for each of the GF categories + topCatRules = [topRule tc [oneOf (map it cs)] | (tc,cs) <- topCats] + where topCats = buildMultiMap [(gfCat origCat, cat) | SRGRule cat origCat _ <- rs] + gfCat = takeWhile (/='{') + it c = symItem [] (Cat c) 0 + topRule i is = Tag "rule" [("id",i),("scope","public")] + (is ++ [tag ["$ = $$"]]) rule :: String -> [XML] -> XML rule i = Tag "rule" [("id",i)] |