generate field names and pipe them to the runtime

This commit is contained in:
krangelov
2021-11-17 11:34:31 +01:00
parent 9e00cdd7f4
commit 6295b32405
2 changed files with 13 additions and 4 deletions

View File

@@ -10,7 +10,7 @@
-----------------------------------------------------------------------------
module GF.Compile.GeneratePMCFG
(generatePMCFG, pgfCncCat, addPMCFG
(generatePMCFG, type2fields, addPMCFG
) where
import GF.Grammar hiding (VApp,VRecType)
@@ -182,4 +182,13 @@ mapAccumM f a (x:xs) = do (a, y) <- f a x
(a,ys) <- mapAccumM f a xs
return (a,y:ys)
pgfCncCat = error "TODO: pgfCncCat"
type2fields :: SourceGrammar -> Type -> [String]
type2fields gr = type2fields empty
where
type2fields d (Sort s) | s == cStr = [show d]
type2fields d (RecType lbls) =
concatMap (\(lbl,ty) -> type2fields (d <+> pp lbl) ty) lbls
type2fields d (Table p q) =
let Ok ts = allParamValues gr p
in concatMap (\t -> type2fields (d <+> ppTerm Unqualified 5 t) q) ts
type2fields d _ = []

View File

@@ -86,8 +86,8 @@ grammar2PGF opts gr am probs = do
0 -> 0
n -> max 0 ((1 - sum [d | (f,Just d) <- pfs]) / fromIntegral n)
createCncCats ((m,c),CncCat _ _ _ _ _) = do
createLincat (i2i c) []
createCncCats ((m,c),CncCat (Just (L _ ty)) _ _ _ _) = do
createLincat (i2i c) (type2fields gr ty)
createCncCats _ = return ()
createCncFuns ((m,f),CncFun _ _ _ (Just prods)) = do