summaryrefslogtreecommitdiff
path: root/src/GF/Speech
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2009-09-11 13:45:34 +0000
committerkrasimir <krasimir@chalmers.se>2009-09-11 13:45:34 +0000
commit1cdf171251a56baf0867b65a95c9bd59801ff912 (patch)
tree837e65fa23f3041c3bbf4b7f1dbfcf63990e09a1 /src/GF/Speech
parent28a7c4b5c7659dc18166e06e914fb0a81c1c43bc (diff)
polish the PGF API and make Expr and Type abstract types. Tree is a type synonym of Expr
Diffstat (limited to 'src/GF/Speech')
-rw-r--r--src/GF/Speech/CFG.hs4
-rw-r--r--src/GF/Speech/PGFToCFG.hs6
-rw-r--r--src/GF/Speech/SISR.hs4
-rw-r--r--src/GF/Speech/SRG.hs4
-rw-r--r--src/GF/Speech/VoiceXML.hs18
5 files changed, 18 insertions, 18 deletions
diff --git a/src/GF/Speech/CFG.hs b/src/GF/Speech/CFG.hs
index 6a34dfba3..9ec8416c5 100644
--- a/src/GF/Speech/CFG.hs
+++ b/src/GF/Speech/CFG.hs
@@ -298,12 +298,12 @@ prProductions prods =
prCFTerm :: CFTerm -> String
prCFTerm = pr 0
where
- pr p (CFObj f args) = paren p (prCId f ++ " (" ++ concat (intersperse "," (map (pr 0) args)) ++ ")")
+ pr p (CFObj f args) = paren p (showCId f ++ " (" ++ concat (intersperse "," (map (pr 0) args)) ++ ")")
pr p (CFAbs i t) = paren p ("\\x" ++ show i ++ ". " ++ pr 0 t)
pr p (CFApp t1 t2) = paren p (pr 1 t1 ++ "(" ++ pr 0 t2 ++ ")")
pr _ (CFRes i) = "$" ++ show i
pr _ (CFVar i) = "x" ++ show i
- pr _ (CFMeta c) = "?" ++ prCId c
+ pr _ (CFMeta c) = "?" ++ showCId c
paren 0 x = x
paren 1 x = "(" ++ x ++ ")"
diff --git a/src/GF/Speech/PGFToCFG.hs b/src/GF/Speech/PGFToCFG.hs
index 4165e0aa1..d22a4ea8d 100644
--- a/src/GF/Speech/PGFToCFG.hs
+++ b/src/GF/Speech/PGFToCFG.hs
@@ -31,7 +31,7 @@ toBNF f pgf cnc = prCFG $ f $ pgfToCFG pgf cnc
pgfToCFG :: PGF
-> CId -- ^ Concrete syntax name
-> CFG
-pgfToCFG pgf lang = mkCFG (prCId (lookStartCat pgf)) extCats (startRules ++ concatMap fruleToCFRule rules)
+pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ concatMap fruleToCFRule rules)
where
pinfo = fromMaybe (error "pgfToCFG: No parser.") (lookParser pgf lang)
@@ -40,7 +40,7 @@ pgfToCFG pgf lang = mkCFG (prCId (lookStartCat pgf)) extCats (startRules ++ conc
, prod <- Set.toList set]
fcatCats :: Map FCat Cat
- fcatCats = Map.fromList [(fc, prCId c ++ "_" ++ show i)
+ fcatCats = Map.fromList [(fc, showCId c ++ "_" ++ show i)
| (c,fcs) <- Map.toList (startCats pinfo),
(fc,i) <- zip fcs [1..]]
@@ -67,7 +67,7 @@ pgfToCFG pgf lang = mkCFG (prCId (lookStartCat pgf)) extCats (startRules ++ conc
extCats = Set.fromList $ map lhsCat startRules
startRules :: [CFRule]
- startRules = [CFRule (prCId c) [NonTerminal (fcatToCat fc r)] (CFRes 0)
+ startRules = [CFRule (showCId c) [NonTerminal (fcatToCat fc r)] (CFRes 0)
| (c,fcs) <- Map.toList (startCats pinfo),
fc <- fcs, not (isLiteralFCat fc),
r <- [0..catLinArity fc-1]]
diff --git a/src/GF/Speech/SISR.hs b/src/GF/Speech/SISR.hs
index 7933a2597..f966d96b9 100644
--- a/src/GF/Speech/SISR.hs
+++ b/src/GF/Speech/SISR.hs
@@ -50,12 +50,12 @@ catSISR t (c,i) fmt
profileFinalSISR :: CFTerm -> SISRFormat -> SISRTag
profileFinalSISR term fmt = [JS.DExpr $ fmtOut fmt `ass` f term]
where
- f (CFObj n ts) = tree (prCId n) (map f ts)
+ f (CFObj n ts) = tree (showCId n) (map f ts)
f (CFAbs v x) = JS.EFun [var v] [JS.SReturn (f x)]
f (CFApp x y) = JS.ECall (f x) [f y]
f (CFRes i) = JS.EIndex (JS.EVar args) (JS.EInt (fromIntegral i))
f (CFVar v) = JS.EVar (var v)
- f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr (prCId typ))]
+ f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr (showCId typ))]
fmtOut SISR_WD20030401 = JS.EVar (JS.Ident "$")
fmtOut SISR_1_0 = JS.EVar (JS.Ident "out")
diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs
index 5d1bbdfed..2270ec7a1 100644
--- a/src/GF/Speech/SRG.hs
+++ b/src/GF/Speech/SRG.hs
@@ -113,12 +113,12 @@ makeNonRecursiveSRG opts = mkSRG cfgToSRG id
mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> CId -> SRG
mkSRG mkRules preprocess pgf cnc =
- SRG { srgName = prCId cnc,
+ SRG { srgName = showCId cnc,
srgStartCat = cfgStartCat cfg,
srgExternalCats = cfgExternalCats cfg,
srgLanguage = getSpeechLanguage pgf cnc,
srgRules = mkRules cfg }
- where cfg = renameCats (prCId cnc) $ preprocess $ pgfToCFG pgf cnc
+ where cfg = renameCats (showCId cnc) $ preprocess $ pgfToCFG pgf cnc
-- | Renames all external cats C to C_cat, and all internal cats C_X (where X is any string),
-- to C_N where N is an integer.
diff --git a/src/GF/Speech/VoiceXML.hs b/src/GF/Speech/VoiceXML.hs
index a30342cd0..cf6f7120f 100644
--- a/src/GF/Speech/VoiceXML.hs
+++ b/src/GF/Speech/VoiceXML.hs
@@ -29,7 +29,7 @@ import Debug.Trace
grammar2vxml :: PGF -> CId -> String
grammar2vxml pgf cnc = showsXMLDoc (skel2vxml name language start skel qs) ""
where skel = pgfSkeleton pgf
- name = prCId cnc
+ name = showCId cnc
qs = catQuestions pgf cnc (map fst skel)
language = getSpeechLanguage pgf cnc
start = lookStartCat pgf
@@ -73,7 +73,7 @@ lin gr fun = do
getCatQuestion :: CId -> CatQuestions -> String
getCatQuestion c qs =
- fromMaybe (error "No question for category " ++ prCId c) (lookup c qs)
+ fromMaybe (error "No question for category " ++ showCId c) (lookup c qs)
--
-- * Generate VoiceXML
@@ -93,7 +93,7 @@ grammarURI name = name ++ ".grxml"
catForms :: String -> CatQuestions -> CId -> [(CId, [CId])] -> [XML]
catForms gr qs cat fs =
- comments [prCId cat ++ " category."]
+ comments [showCId cat ++ " category."]
++ [cat2form gr qs cat fs]
cat2form :: String -> CatQuestions -> CId -> [(CId, [CId])] -> XML
@@ -111,20 +111,20 @@ cat2form gr qs cat fs =
fun2sub :: String -> CId -> CId -> [CId] -> [XML]
fun2sub gr cat fun args =
- comments [prCId fun ++ " : ("
- ++ concat (intersperse ", " (map prCId args))
- ++ ") " ++ prCId cat] ++ ss
+ comments [showCId fun ++ " : ("
+ ++ concat (intersperse ", " (map showCId args))
+ ++ ") " ++ showCId cat] ++ ss
where
ss = zipWith mkSub [0..] args
mkSub n t = subdialog s [("src","#"++catFormId t),
- ("cond","term.name == "++string (prCId fun))]
+ ("cond","term.name == "++string (showCId fun))]
[param "old" v,
filled [] [assign v (s++".term")]]
- where s = prCId fun ++ "_" ++ show n
+ where s = showCId fun ++ "_" ++ show n
v = "term.args["++show n++"]"
catFormId :: CId -> String
-catFormId c = prCId c ++ "_cat"
+catFormId c = showCId c ++ "_cat"
--