mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 11:42:49 -06:00
printnames are now kept as String instead of Term in PGF
This commit is contained in:
@@ -5,6 +5,7 @@ import GF.Compile.Export
|
|||||||
import GF.Compile.GeneratePMCFG
|
import GF.Compile.GeneratePMCFG
|
||||||
|
|
||||||
import PGF.CId
|
import PGF.CId
|
||||||
|
import PGF.Linearize(realize)
|
||||||
import qualified PGF.Macros as CM
|
import qualified PGF.Macros as CM
|
||||||
import qualified PGF.Data as C
|
import qualified PGF.Data as C
|
||||||
import qualified PGF.Data as D
|
import qualified PGF.Data as D
|
||||||
@@ -102,8 +103,8 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,abm):cms)) =
|
|||||||
lindefs = Map.fromAscList
|
lindefs = Map.fromAscList
|
||||||
[(i2i c, umkTerm tr) | (c,CncCat _ (Just tr) _) <- js]
|
[(i2i c, umkTerm tr) | (c,CncCat _ (Just tr) _) <- js]
|
||||||
printnames = Map.union
|
printnames = Map.union
|
||||||
(Map.fromAscList [(i2i f, umkTerm tr) | (f,CncFun _ _ (Just tr)) <- js])
|
(Map.fromAscList [(i2i f, realize (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,CncCat _ _ (Just tr)) <- js])
|
||||||
params = Map.fromAscList
|
params = Map.fromAscList
|
||||||
[(i2i c, pars lang0 c) | (c,CncCat (Just ty) _ _) <- js]
|
[(i2i c, pars lang0 c) | (c,CncCat (Just ty) _ _) <- js]
|
||||||
fcfg = Nothing
|
fcfg = Nothing
|
||||||
|
|||||||
@@ -21,8 +21,7 @@ suffixOptimize = mapConcretes opt
|
|||||||
where
|
where
|
||||||
opt cnc = cnc {
|
opt cnc = cnc {
|
||||||
lins = Map.map optTerm (lins cnc),
|
lins = Map.map optTerm (lins cnc),
|
||||||
lindefs = Map.map optTerm (lindefs cnc),
|
lindefs = Map.map optTerm (lindefs cnc)
|
||||||
printnames = Map.map optTerm (printnames cnc)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
cseOptimize :: PGF -> PGF
|
cseOptimize :: PGF -> PGF
|
||||||
@@ -66,8 +65,7 @@ addSubexpConsts :: TermList -> Concr -> Concr
|
|||||||
addSubexpConsts tree cnc = cnc {
|
addSubexpConsts tree cnc = cnc {
|
||||||
opers = Map.fromList [(f,recomp f trm) | (f,trm) <- ops],
|
opers = Map.fromList [(f,recomp f trm) | (f,trm) <- ops],
|
||||||
lins = rec lins,
|
lins = rec lins,
|
||||||
lindefs = rec lindefs,
|
lindefs = rec lindefs
|
||||||
printnames = rec printnames
|
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
ops = [(fid id, trm) | (trm,(_,id)) <- Map.assocs tree]
|
ops = [(fid id, trm) | (trm,(_,id)) <- Map.assocs tree]
|
||||||
@@ -88,7 +86,6 @@ getSubtermsMod :: Concr -> TermM TermList
|
|||||||
getSubtermsMod cnc = do
|
getSubtermsMod cnc = do
|
||||||
mapM getSubterms (Map.assocs (lins cnc))
|
mapM getSubterms (Map.assocs (lins cnc))
|
||||||
mapM getSubterms (Map.assocs (lindefs cnc))
|
mapM getSubterms (Map.assocs (lindefs cnc))
|
||||||
mapM getSubterms (Map.assocs (printnames cnc))
|
|
||||||
(tree0,_) <- readSTM
|
(tree0,_) <- readSTM
|
||||||
return $ Map.filter (\ (nu,_) -> nu > 1) tree0
|
return $ Map.filter (\ (nu,_) -> nu > 1) tree0
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -16,7 +16,7 @@ import GF.Speech.SRG (getSpeechLanguage)
|
|||||||
import PGF.CId
|
import PGF.CId
|
||||||
import PGF.Data
|
import PGF.Data
|
||||||
import PGF.Macros
|
import PGF.Macros
|
||||||
import PGF.Linearize (realize)
|
import PGF.Linearize (showPrintName)
|
||||||
|
|
||||||
import Control.Monad (liftM)
|
import Control.Monad (liftM)
|
||||||
import Data.List (isPrefixOf, find, intersperse)
|
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]
|
catQuestions pgf cnc cats = [(c,catQuestion pgf cnc c) | c <- cats]
|
||||||
|
|
||||||
catQuestion :: PGF -> CId -> CId -> String
|
catQuestion :: PGF -> CId -> CId -> String
|
||||||
catQuestion pgf cnc cat = realize (lookPrintName pgf cnc cat)
|
catQuestion pgf cnc cat = showPrintName pgf cnc cat
|
||||||
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
|
|||||||
@@ -155,9 +155,6 @@ linearizeAll :: PGF -> Tree -> [String]
|
|||||||
-- available in the grammar.
|
-- available in the grammar.
|
||||||
linearizeAllLang :: PGF -> Tree -> [(Language,String)]
|
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 same as 'parseAllLang' but does not return
|
||||||
-- the language.
|
-- the language.
|
||||||
parseAll :: PGF -> Type -> String -> [[Tree]]
|
parseAll :: PGF -> Type -> String -> [[Tree]]
|
||||||
@@ -260,8 +257,6 @@ linearizeAll mgr = map snd . linearizeAllLang mgr
|
|||||||
linearizeAllLang mgr t =
|
linearizeAllLang mgr t =
|
||||||
[(lang,PGF.linearize mgr lang t) | lang <- languages mgr]
|
[(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
|
parseAll mgr typ = map snd . parseAllLang mgr typ
|
||||||
|
|
||||||
parseAllLang mgr typ s =
|
parseAllLang mgr typ s =
|
||||||
|
|||||||
@@ -35,7 +35,7 @@ data Concr = Concr {
|
|||||||
opers :: Map.Map CId Term, -- oper generated by subex elim
|
opers :: Map.Map CId Term, -- oper generated by subex elim
|
||||||
lincats :: Map.Map CId Term, -- lin type of a cat
|
lincats :: Map.Map CId Term, -- lin type of a cat
|
||||||
lindefs :: Map.Map CId Term, -- lin default 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
|
paramlincats :: Map.Map CId Term, -- lin type of cat, with printable param names
|
||||||
parser :: Maybe ParserInfo -- parser
|
parser :: Maybe ParserInfo -- parser
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
{-# LANGUAGE ParallelListComp #-}
|
{-# LANGUAGE ParallelListComp #-}
|
||||||
module PGF.Linearize
|
module PGF.Linearize
|
||||||
(linearizes,realize,realizes,linTree, linTreeMark,linearizesMark) where
|
(linearizes,showPrintName,realize,realizes,linTree, linTreeMark,linearizesMark) where
|
||||||
|
|
||||||
import PGF.CId
|
import PGF.CId
|
||||||
import PGF.Data
|
import PGF.Data
|
||||||
@@ -164,3 +164,7 @@ linTreeMark pgf lang = lin [] . expr2tree
|
|||||||
|
|
||||||
bracket p ts = [kks ("("++show p)] ++ ts ++ [kks ")"]
|
bracket p ts = [kks ("("++show p)] ++ ts ++ [kks ")"]
|
||||||
sub p i = p ++ [i]
|
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
|
||||||
|
|||||||
@@ -29,10 +29,6 @@ lookParamLincat :: PGF -> CId -> CId -> Term
|
|||||||
lookParamLincat pgf lang fun =
|
lookParamLincat pgf lang fun =
|
||||||
lookMap tm0 fun $ paramlincats $ lookMap (error "no lang") lang $ concretes pgf
|
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 -> CId -> Type
|
||||||
lookType pgf f =
|
lookType pgf f =
|
||||||
case lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf)) of
|
case lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf)) of
|
||||||
|
|||||||
Reference in New Issue
Block a user