diff options
| author | krasimir <krasimir@chalmers.se> | 2009-09-11 13:45:34 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2009-09-11 13:45:34 +0000 |
| commit | 1cdf171251a56baf0867b65a95c9bd59801ff912 (patch) | |
| tree | 837e65fa23f3041c3bbf4b7f1dbfcf63990e09a1 /src/GF/Speech | |
| parent | 28a7c4b5c7659dc18166e06e914fb0a81c1c43bc (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.hs | 4 | ||||
| -rw-r--r-- | src/GF/Speech/PGFToCFG.hs | 6 | ||||
| -rw-r--r-- | src/GF/Speech/SISR.hs | 4 | ||||
| -rw-r--r-- | src/GF/Speech/SRG.hs | 4 | ||||
| -rw-r--r-- | src/GF/Speech/VoiceXML.hs | 18 |
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" -- |
