GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-20 00:22:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

added API for print names

Browse Source
This commit is contained in:
krangelov
2021-12-03 16:49:36 +01:00
parent 655576c291
commit bbff79aaa3
10 changed files with 86 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

@@ -32,10 +32,15 @@ generatePMCFG opts cwd gr cmo@(cm,cmi) = do
js <- mapM (addPMCFG opts cwd gr' cmi) (Map.toList (jments cmi))
return (cm,cmi{jments = (Map.fromAscList js)})
addPMCFG opts cwd gr cmi (id,CncFun mty@(Just (_,cat,ctxt,val)) mlin@(Just (L loc term)) mprn Nothing) =
checkInModule cwd cmi loc ("Happened in the PMCFG generation for" <+> id) $ do
rules <- pmcfgForm gr term ctxt val
return (id,CncFun mty mlin mprn (Just rules))
addPMCFG opts cwd gr cmi (id,CncFun mty@(Just (_,cat,ctxt,val)) mlin@(Just (L loc term)) mprn Nothing) = do
rules <- checkInModule cwd cmi loc ("Happened in the PMCFG generation for" <+> id) $
pmcfgForm gr term ctxt val
mprn <- case mprn of
Nothing -> return Nothing
Just (L loc prn) -> checkInModule cwd cmi loc ("Happened in the computation of the print name for" <+> id) $ do
prn <- normalForm gr prn
return (Just (L loc prn))
return (id,CncFun mty mlin mprn (Just rules))
addPMCFG opts cwd gr cmi id_info = return id_info
pmcfgForm :: Grammar -> Term -> Context -> Type -> Check [Production]

10
src/compiler/GF/Compile/GrammarToPGF.hs
View File

@@ -90,10 +90,18 @@ grammar2PGF opts gr am probs = do
createLincat (i2i c) (type2fields gr ty)
createCncCats _ = return ()
createCncFuns ((m,f),CncFun _ _ _ (Just prods)) = do
createCncFuns ((m,f),CncFun _ _ mprn (Just prods)) = do
createLin (i2i f) prods
case mprn of
Nothing -> return ()
Just (L _ prn) -> setPrintName (i2i f) (unwords (term2tokens prn))
createCncFuns _ = return ()
term2tokens (K tok) = [tok]
term2tokens (C t1 t2) = term2tokens t1 ++ term2tokens t2
term2tokens (Typed t _) = term2tokens t
term2tokens _ = []
i2i :: Ident -> String
i2i = showIdent