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