summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/compiler/GF/Compile/GrammarToPGF.hs5
-rw-r--r--src/compiler/GF/Compile/OptimizePGF.hs7
-rw-r--r--src/compiler/GF/Speech/VoiceXML.hs4
-rw-r--r--src/runtime/haskell/PGF.hs5
-rw-r--r--src/runtime/haskell/PGF/Data.hs2
-rw-r--r--src/runtime/haskell/PGF/Linearize.hs6
-rw-r--r--src/runtime/haskell/PGF/Macros.hs4
7 files changed, 13 insertions, 20 deletions
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index 2a4085cc3..0e58398d6 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -5,6 +5,7 @@ import GF.Compile.Export
import GF.Compile.GeneratePMCFG
import PGF.CId
+import PGF.Linearize(realize)
import qualified PGF.Macros as CM
import qualified PGF.Data as C
import qualified PGF.Data as D
@@ -102,8 +103,8 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,abm):cms)) =
lindefs = Map.fromAscList
[(i2i c, umkTerm tr) | (c,CncCat _ (Just tr) _) <- js]
printnames = Map.union
- (Map.fromAscList [(i2i f, umkTerm tr) | (f,CncFun _ _ (Just tr)) <- js])
- (Map.fromAscList [(i2i f, umkTerm tr) | (f,CncCat _ _ (Just tr)) <- js])
+ (Map.fromAscList [(i2i f, realize (umkTerm tr)) | (f,CncFun _ _ (Just tr)) <- js])
+ (Map.fromAscList [(i2i f, realize (umkTerm tr)) | (f,CncCat _ _ (Just tr)) <- js])
params = Map.fromAscList
[(i2i c, pars lang0 c) | (c,CncCat (Just ty) _ _) <- js]
fcfg = Nothing
diff --git a/src/compiler/GF/Compile/OptimizePGF.hs b/src/compiler/GF/Compile/OptimizePGF.hs
index b23560437..4ef8ce5cf 100644
--- a/src/compiler/GF/Compile/OptimizePGF.hs
+++ b/src/compiler/GF/Compile/OptimizePGF.hs
@@ -21,8 +21,7 @@ suffixOptimize = mapConcretes opt
where
opt cnc = cnc {
lins = Map.map optTerm (lins cnc),
- lindefs = Map.map optTerm (lindefs cnc),
- printnames = Map.map optTerm (printnames cnc)
+ lindefs = Map.map optTerm (lindefs cnc)
}
cseOptimize :: PGF -> PGF
@@ -66,8 +65,7 @@ addSubexpConsts :: TermList -> Concr -> Concr
addSubexpConsts tree cnc = cnc {
opers = Map.fromList [(f,recomp f trm) | (f,trm) <- ops],
lins = rec lins,
- lindefs = rec lindefs,
- printnames = rec printnames
+ lindefs = rec lindefs
}
where
ops = [(fid id, trm) | (trm,(_,id)) <- Map.assocs tree]
@@ -88,7 +86,6 @@ getSubtermsMod :: Concr -> TermM TermList
getSubtermsMod cnc = do
mapM getSubterms (Map.assocs (lins cnc))
mapM getSubterms (Map.assocs (lindefs cnc))
- mapM getSubterms (Map.assocs (printnames cnc))
(tree0,_) <- readSTM
return $ Map.filter (\ (nu,_) -> nu > 1) tree0
where
diff --git a/src/compiler/GF/Speech/VoiceXML.hs b/src/compiler/GF/Speech/VoiceXML.hs
index 134964062..fb25d6a1e 100644
--- a/src/compiler/GF/Speech/VoiceXML.hs
+++ b/src/compiler/GF/Speech/VoiceXML.hs
@@ -16,7 +16,7 @@ import GF.Speech.SRG (getSpeechLanguage)
import PGF.CId
import PGF.Data
import PGF.Macros
-import PGF.Linearize (realize)
+import PGF.Linearize (showPrintName)
import Control.Monad (liftM)
import Data.List (isPrefixOf, find, intersperse)
@@ -55,7 +55,7 @@ catQuestions :: PGF -> CId -> [CId] -> CatQuestions
catQuestions pgf cnc cats = [(c,catQuestion pgf cnc c) | c <- cats]
catQuestion :: PGF -> CId -> CId -> String
-catQuestion pgf cnc cat = realize (lookPrintName pgf cnc cat)
+catQuestion pgf cnc cat = showPrintName pgf cnc cat
{-
diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs
index 2b521e8f7..14e157bb6 100644
--- a/src/runtime/haskell/PGF.hs
+++ b/src/runtime/haskell/PGF.hs
@@ -155,9 +155,6 @@ linearizeAll :: PGF -> Tree -> [String]
-- available in the grammar.
linearizeAllLang :: PGF -> Tree -> [(Language,String)]
--- | Show the printname of a type
-showPrintName :: PGF -> Language -> Type -> String
-
-- | The same as 'parseAllLang' but does not return
-- the language.
parseAll :: PGF -> Type -> String -> [[Tree]]
@@ -260,8 +257,6 @@ linearizeAll mgr = map snd . linearizeAllLang mgr
linearizeAllLang mgr t =
[(lang,PGF.linearize mgr lang t) | lang <- languages mgr]
-showPrintName pgf lang (DTyp _ c _) = realize $ lookPrintName pgf lang c
-
parseAll mgr typ = map snd . parseAllLang mgr typ
parseAllLang mgr typ s =
diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs
index 38027e96e..dcdf38dcb 100644
--- a/src/runtime/haskell/PGF/Data.hs
+++ b/src/runtime/haskell/PGF/Data.hs
@@ -35,7 +35,7 @@ data Concr = Concr {
opers :: Map.Map CId Term, -- oper generated by subex elim
lincats :: Map.Map CId Term, -- lin type of a cat
lindefs :: Map.Map CId Term, -- lin default of a cat
- printnames :: Map.Map CId Term, -- printname of a cat or a fun
+ printnames :: Map.Map CId String, -- printname of a cat or a fun
paramlincats :: Map.Map CId Term, -- lin type of cat, with printable param names
parser :: Maybe ParserInfo -- parser
}
diff --git a/src/runtime/haskell/PGF/Linearize.hs b/src/runtime/haskell/PGF/Linearize.hs
index 80d1f1acf..de3daf11d 100644
--- a/src/runtime/haskell/PGF/Linearize.hs
+++ b/src/runtime/haskell/PGF/Linearize.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE ParallelListComp #-}
module PGF.Linearize
- (linearizes,realize,realizes,linTree, linTreeMark,linearizesMark) where
+ (linearizes,showPrintName,realize,realizes,linTree, linTreeMark,linearizesMark) where
import PGF.CId
import PGF.Data
@@ -164,3 +164,7 @@ linTreeMark pgf lang = lin [] . expr2tree
bracket p ts = [kks ("("++show p)] ++ ts ++ [kks ")"]
sub p i = p ++ [i]
+
+-- | Show the printname of function or category
+showPrintName :: PGF -> Language -> CId -> String
+showPrintName pgf lang id = lookMap "?" id $ printnames $ lookMap (error "no lang") lang $ concretes pgf
diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs
index af25de025..2f6282aa3 100644
--- a/src/runtime/haskell/PGF/Macros.hs
+++ b/src/runtime/haskell/PGF/Macros.hs
@@ -29,10 +29,6 @@ lookParamLincat :: PGF -> CId -> CId -> Term
lookParamLincat pgf lang fun =
lookMap tm0 fun $ paramlincats $ lookMap (error "no lang") lang $ concretes pgf
-lookPrintName :: PGF -> CId -> CId -> Term
-lookPrintName pgf lang fun =
- lookMap tm0 fun $ printnames $ lookMap (error "no lang") lang $ concretes pgf
-
lookType :: PGF -> CId -> Type
lookType pgf f =
case lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf)) of