Add GF.Speech.SRG.isExternalCat

This commit is contained in:
bjorn
2008-06-12 18:35:25 +00:00
parent 43459c75c8
commit b76c8c195c
2 changed files with 6 additions and 3 deletions

View File

@@ -8,12 +8,13 @@
-- FIXME: remove \/ warn \/ fail if there are int \/ string literal -- FIXME: remove \/ warn \/ fail if there are int \/ string literal
-- categories in the grammar -- categories in the grammar
---------------------------------------------------------------------- ----------------------------------------------------------------------
module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol
, SRGNT, CFTerm , SRGNT, CFTerm
, makeSRG , makeSRG
, makeSimpleSRG , makeSimpleSRG
, makeNonRecursiveSRG , makeNonRecursiveSRG
, getSpeechLanguage , getSpeechLanguage
, isExternalCat
, lookupFM_, prtS , lookupFM_, prtS
) where ) where
@@ -139,6 +140,9 @@ cfRulesToSRGRule rs@(r:_) = SRGRule (lhsCat r) rhs
allSRGCats :: SRG -> [String] allSRGCats :: SRG -> [String]
allSRGCats SRG { srgRules = rs } = [c | SRGRule c _ <- rs] allSRGCats SRG { srgRules = rs } = [c | SRGRule c _ <- rs]
isExternalCat :: SRG -> Cat -> Bool
isExternalCat srg c = c `Set.member` srgExternalCats srg
-- --
-- * Size-optimized EBNF SRGs -- * Size-optimized EBNF SRGs
-- --

View File

@@ -20,7 +20,6 @@ import Data.Char (toUpper,toLower)
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set
srgsXmlPrinter :: Maybe SISRFormat srgsXmlPrinter :: Maybe SISRFormat
-> PGF -> CId -> String -> PGF -> CId -> String
@@ -39,7 +38,7 @@ prSrgsXml sisr srg = showXMLDoc (optimizeSRGS xmlGr)
meta "generator" "Grammatical Framework"] meta "generator" "Grammatical Framework"]
++ map ruleToXML (srgRules srg) ++ map ruleToXML (srgRules srg)
ruleToXML (SRGRule cat alts) = Tag "rule" ([("id",cat)]++pub) (prRhs alts) ruleToXML (SRGRule cat alts) = Tag "rule" ([("id",cat)]++pub) (prRhs alts)
where pub | cat `Set.member` srgExternalCats srg = [("scope","public")] where pub | isExternalCat srg cat = [("scope","public")]
| otherwise = [] | otherwise = []
prRhs rhss = [oneOf (map (mkProd sisr) rhss)] prRhs rhss = [oneOf (map (mkProd sisr) rhss)]