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

fix the case PType => PType

Browse Source
This commit is contained in:
Krasimir Angelov
2025-08-26 19:45:31 +02:00
parent cbac8b4fd2
commit c02a0c4159
1 changed files with 10 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/compiler/api/GF/Compile/GeneratePMCFG.hs
+10 -1
View File
@@ -131,13 +131,22 @@ type2metaTerm gr d ms r rs (RecType lbls) = do
type2metaTerm gr d ms r rs (Table p q) type2metaTerm gr d ms r rs (Table p q)
| count == 1 = do (ms',r',t) <- type2metaTerm gr d ms r rs q | count == 1 = do (ms',r',t) <- type2metaTerm gr d ms r rs q
return (ms',r+(r'-r),T (TTyped p) [(PW,t)]) return (ms',r+(r'-r),T (TTyped p) [(PW,t)])
| otherwise = do let pv = varX (length rs+1) | null (collectParams q)
= do let pv = varX (length rs+1)
(ms',delta,t) <- (ms',delta,t) <-
fixST $ \(~(_,delta,_)) -> fixST $ \(~(_,delta,_)) ->
do (ms',r',t) <- type2metaTerm gr d ms r ((delta,(pv,p)):rs) q do (ms',r',t) <- type2metaTerm gr d ms r ((delta,(pv,p)):rs) q
return (ms',r'-r,t) return (ms',r'-r,t)
return (ms',r+delta*count,T (TTyped p) [(PV pv,t)]) return (ms',r+delta*count,T (TTyped p) [(PV pv,t)])
| otherwise = do ((ms',r'),ts) <- mapAccumM (\(ms,r) _ -> do (ms',r',t) <- type2metaTerm gr d ms r rs q
return ((ms',r'),t))
(ms,r) [0..count-1]
return (ms',r+(r'-r),V p ts)
where where
collectParams (QC q) = [q]
collectParams (Table _ t) = collectParams t
collectParams t = collectOp collectParams t
count = case allParamValues gr p of count = case allParamValues gr p of
Ok ts -> length ts Ok ts -> length ts
Bad msg -> error msg Bad msg -> error msg