diff options
| author | krasimir <krasimir@chalmers.se> | 2009-05-22 18:54:51 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2009-05-22 18:54:51 +0000 |
| commit | 41b263cf6aa38e7c6ef090c0fa18949b86eec62c (patch) | |
| tree | 9e604716ed1455238c3c49cf8add777c0cdf74d4 /src/GF/Compile/GeneratePMCFG.hs | |
| parent | 7a204376c91ea9647ec4418cfcd3ed0dd7891fae (diff) | |
some work on evaluation with abstract expressions in PGF
Diffstat (limited to 'src/GF/Compile/GeneratePMCFG.hs')
| -rw-r--r-- | src/GF/Compile/GeneratePMCFG.hs | 8 |
1 files changed, 4 insertions, 4 deletions
diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs index 772adf81a..667b403b5 100644 --- a/src/GF/Compile/GeneratePMCFG.hs +++ b/src/GF/Compile/GeneratePMCFG.hs @@ -38,14 +38,14 @@ convertConcrete abs cnc = convert abs_defs conc cats conc = Map.union (opers cnc) (lins cnc) -- "union big+small most efficient" cats = lincats cnc -convert :: [(CId,(Type,[Equation]))] -> TermMap -> TermMap -> ParserInfo +convert :: [(CId,(Type,Int,[Equation]))] -> TermMap -> TermMap -> ParserInfo convert abs_defs cnc_defs cat_defs = let env = expandHOAS abs_defs cnc_defs cat_defs (emptyGrammarEnv cnc_defs cat_defs) in getParserInfo (List.foldl' (convertRule cnc_defs) env pfrules) where pfrules = [ (PFRule id args (0,res) (map findLinType args) (findLinType (0,res)) term) | - (id, (ty,_)) <- abs_defs, let (args,res) = typeSkeleton ty, + (id, (ty,_,_)) <- abs_defs, let (args,res) = typeSkeleton ty, term <- maybeToList (Map.lookup id cnc_defs)] findLinType (_,id) = fromMaybe (error $ "No lincat for " ++ show id) (Map.lookup id cat_defs) @@ -320,11 +320,11 @@ expandHOAS abs_defs cnc_defs lincats env = foldl add_varFun (foldl (\env ncat -> add_hoFun (add_hoCat env ncat) ncat) env hoTypes) hoCats where hoTypes :: [(Int,CId)] - hoTypes = sortNub [(n,c) | (_,(ty,_)) <- abs_defs + hoTypes = sortNub [(n,c) | (_,(ty,_,_)) <- abs_defs , (n,c) <- fst (typeSkeleton ty), n > 0] hoCats :: [CId] - hoCats = sortNub [c | (_,(ty,_)) <- abs_defs + hoCats = sortNub [c | (_,(ty,_,_)) <- abs_defs , Hyp _ ty <- case ty of {DTyp hyps val _ -> hyps} , c <- fst (catSkeleton ty)] |