forked from GitHub/gf-core
Add GF.Speech.SRG.isExternalCat
This commit is contained in:
@@ -8,12 +8,13 @@
|
||||
-- FIXME: remove \/ warn \/ fail if there are int \/ string literal
|
||||
-- categories in the grammar
|
||||
----------------------------------------------------------------------
|
||||
module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem
|
||||
module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol
|
||||
, SRGNT, CFTerm
|
||||
, makeSRG
|
||||
, makeSimpleSRG
|
||||
, makeNonRecursiveSRG
|
||||
, getSpeechLanguage
|
||||
, isExternalCat
|
||||
, lookupFM_, prtS
|
||||
) where
|
||||
|
||||
@@ -139,6 +140,9 @@ cfRulesToSRGRule rs@(r:_) = SRGRule (lhsCat r) rhs
|
||||
allSRGCats :: SRG -> [String]
|
||||
allSRGCats SRG { srgRules = rs } = [c | SRGRule c _ <- rs]
|
||||
|
||||
isExternalCat :: SRG -> Cat -> Bool
|
||||
isExternalCat srg c = c `Set.member` srgExternalCats srg
|
||||
|
||||
--
|
||||
-- * Size-optimized EBNF SRGs
|
||||
--
|
||||
|
||||
@@ -20,7 +20,6 @@ import Data.Char (toUpper,toLower)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
srgsXmlPrinter :: Maybe SISRFormat
|
||||
-> PGF -> CId -> String
|
||||
@@ -39,7 +38,7 @@ prSrgsXml sisr srg = showXMLDoc (optimizeSRGS xmlGr)
|
||||
meta "generator" "Grammatical Framework"]
|
||||
++ map ruleToXML (srgRules srg)
|
||||
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 = []
|
||||
prRhs rhss = [oneOf (map (mkProd sisr) rhss)]
|
||||
|
||||
|
||||
Reference in New Issue
Block a user