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

deepForce VSymCat

Browse Source
This commit is contained in:
Krasimir Angelov
2022-01-11 12:48:14 +01:00
parent a8c40db453
commit 54993bce12
1 changed files with 10 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -28,6 +28,7 @@ import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import Data.List(mapAccumL,sortOn,sortBy) import Data.List(mapAccumL,sortOn,sortBy)
import Data.Maybe(fromMaybe,isNothing) import Data.Maybe(fromMaybe,isNothing)
import Debug.Trace
generatePMCFG :: Options -> FilePath -> SourceGrammar -> SourceModule -> Check SourceModule generatePMCFG :: Options -> FilePath -> SourceGrammar -> SourceModule -> Check SourceModule
generatePMCFG opts cwd gr cmo@(cm,cmi) generatePMCFG opts cwd gr cmo@(cm,cmi)
@@ -181,6 +182,15 @@ deepForce (VApp q tnks) = mapM_ (\tnk -> force tnk >>= deepForce) tnks
deepForce (VC v1 v2) = deepForce v1 >> deepForce v2 deepForce (VC v1 v2) = deepForce v1 >> deepForce v2
deepForce (VAlts def alts) = do deepForce def deepForce (VAlts def alts) = do deepForce def
mapM_ (\(v,_) -> deepForce v) alts mapM_ (\(v,_) -> deepForce v) alts
deepForce (VSymCat d r rs) = mapM_ (\(_,(tnk,_)) -> force tnk >>= deepForce) rs
where
compute r' [] = return (r',[])
compute r' ((cnt',(tnk,ty)):tnks) = do
v <- force tnk
(r, rs,_) <- param2int v ty
(r',rs' ) <- compute r' tnks
return (r*cnt'+r',combine cnt' rs rs')
deepForce _ = return () deepForce _ = return ()
str2lin (VApp q []) str2lin (VApp q [])