msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

the compiler and the Haskell runtime now support abstract senses

Browse Source
This commit is contained in:
Krasimir Angelov
2018-11-02 14:01:54 +01:00
parent 777028dcd8
commit bf5abe2948
12 changed files with 127 additions and 117 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/compiler/GF/Speech/PGFToCFG.hs
View File

@@ -74,12 +74,15 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co
ruleToCFRule :: (FId,Production) -> [CFRule]
ruleToCFRule (c,PApply funid args) =
[Rule (fcatToCat c l) (mkRhs row) (profilesToTerm [fixProfile row n | n <- [0..length args-1]])
[Rule (fcatToCat c l) (mkRhs row) term
| (l,seqid) <- Array.assocs rhs
, let row = sequences cnc ! seqid
, not (containsLiterals row)]
, not (containsLiterals row)
, f <- fns
, let term = profilesToTerm f [fixProfile row n | n <- [0..length args-1]]
]
where
CncFun f rhs = cncfuns cnc ! funid
CncFun fns rhs = cncfuns cnc ! funid
mkRhs :: Array DotPos Symbol -> [CFSymbol]
mkRhs = concatMap symbolToCFSymbol . Array.elems
@@ -111,8 +114,8 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co
getPos (SymLit j _) = [j]
getPos _ = []
profilesToTerm :: [Profile] -> CFTerm
profilesToTerm ps = CFObj f (zipWith profileToTerm argTypes ps)
profilesToTerm :: CId -> [Profile] -> CFTerm
profilesToTerm f ps = CFObj f (zipWith profileToTerm argTypes ps)
where (argTypes,_) = catSkeleton $ lookType (abstract pgf) f
profileToTerm :: CId -> Profile -> CFTerm