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

GF.Grammar.Lookup.allParamValues now works for table types as well

Browse Source
This commit is contained in:
krasimir
2010-06-17 09:51:10 +00:00
parent 286358f6ad
commit faceaffe79
1 changed files with 11 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
src/compiler/GF/Grammar/Lookup.hs
View File

@@ -133,15 +133,20 @@ lookupParamValues gr c = do
_ -> Bad $ render (ppQIdent Qualified c <+> text "has no parameter values defined") _ -> Bad $ render (ppQIdent Qualified c <+> text "has no parameter values defined")
allParamValues :: SourceGrammar -> Type -> Err [Term] allParamValues :: SourceGrammar -> Type -> Err [Term]
allParamValues cnc ptyp = case ptyp of allParamValues cnc ptyp =
_ | Just n <- isTypeInts ptyp -> return [EInt i | i <- [0..n]] case ptyp of
QC c -> lookupParamValues cnc c _ | Just n <- isTypeInts ptyp -> return [EInt i | i <- [0..n]]
Q c -> lookupResDef cnc c >>= allParamValues cnc QC c -> lookupParamValues cnc c
RecType r -> do Q c -> lookupResDef cnc c >>= allParamValues cnc
RecType r -> do
let (ls,tys) = unzip $ sortByFst r let (ls,tys) = unzip $ sortByFst r
tss <- mapM (allParamValues cnc) tys tss <- mapM (allParamValues cnc) tys
return [R (zipAssign ls ts) | ts <- combinations tss] return [R (zipAssign ls ts) | ts <- combinations tss]
_ -> Bad (render (text "cannot find parameter values for" <+> ppTerm Unqualified 0 ptyp)) Table pt vt -> do
pvs <- allParamValues cnc pt
vvs <- allParamValues cnc vt
return [V pt ts | ts <- combinations (replicate (length pvs) vvs)]
_ -> Bad (render (text "cannot find parameter values for" <+> ppTerm Unqualified 0 ptyp))
where where
-- to normalize records and record types -- to normalize records and record types
sortByFst = sortBy (\ x y -> compare (fst x) (fst y)) sortByFst = sortBy (\ x y -> compare (fst x) (fst y))