GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-08-19 18:56:21 -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 (ms,s',t',arg_params) = apply 0 Map.empty unit ctxt t []
let v = eval g [] s' t' [] let v = eval g [] s' t' []
(ms,_,_,fn) <- breakDown g ms unit 0 [] v ty (return []) empty (ms,_,_,fn) <- breakDown g ms unit 0 [] v ty (return []) empty
fmap nubOrd $ runGenM g ms [] $ do res <- fmap nubOrd $ runGenM g ms [] $ do
(r,rs,v,res_params) <- fn (r,rs,v,res_params) <- fn
(subst,arg_params) <- mapAccumM params2int Map.empty arg_params (subst,arg_params) <- mapAccumM params2int Map.empty arg_params
(subst,res_params) <- params2int subst res_params (subst,res_params) <- params2int subst res_params
(subst,lin_idx) <- params2int' subst r rs (subst,lin_idx) <- params2int' subst r rs
(subst,seq) <- flatten subst v (subst,seq) <- flatten subst v
qs <- quantifiers (Map.toList subst) qs <- quantifiers (Map.toList subst)
return (Rule qs res_params arg_params lin_idx seq) return (Rule qs res_params arg_params lin_idx seq)
length res `seq` return res
where where
Gl sgr _ _ = g Gl sgr _ _ = g