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

make the PMCFG generation strict

Browse Source
This commit is contained in:
Krasimir Angelov
2026-06-05 10:25:11 +02:00
parent a931b58dd9
commit b89fca9dd7
1 changed files with 9 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/compiler/api/GF/Compile/GeneratePMCFG.hs
+9 -8
View File
@@ -74,14 +74,15 @@ pmcfgForm g t ctxt ty = do
let (ms,s',t',arg_params) = apply 0 Map.empty unit ctxt t []
let v = eval g [] s' t' []
(ms,_,_,fn) <- breakDown g ms unit 0 [] v ty (return []) empty
fmap nubOrd $ runGenM g ms [] $ do
(r,rs,v,res_params) <- fn
(subst,arg_params) <- mapAccumM params2int Map.empty arg_params
(subst,res_params) <- params2int subst res_params
(subst,lin_idx) <- params2int' subst r rs
(subst,seq) <- flatten subst v
qs <- quantifiers (Map.toList subst)
return (Rule qs res_params arg_params lin_idx seq)
res <- fmap nubOrd $ runGenM g ms [] $ do
(r,rs,v,res_params) <- fn
(subst,arg_params) <- mapAccumM params2int Map.empty arg_params
(subst,res_params) <- params2int subst res_params
(subst,lin_idx) <- params2int' subst r rs
(subst,seq) <- flatten subst v
qs <- quantifiers (Map.toList subst)
return (Rule qs res_params arg_params lin_idx seq)
length res `seq` return res
where
Gl sgr _ _ = g