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

build parsers on demand if they aren't in the PGF file

Browse Source
This commit is contained in:
krasimir
2008-09-16 15:35:15 +00:00
parent a0fb2a0b0b
commit 9827f433fb
2 changed files with 31 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
GF.cabal
View File

@@ -584,7 +584,10 @@ library
GF.Data.Assoc
GF.Data.ErrM
GF.Text.UTF8
-- needed only for the on demand generation of PMCFG
GF.Data.BacktrackM
GF.Compile.GenerateFCFG
GF.Compile.GeneratePMCFG
executable gf
build-depends: base,

40
src/PGF/Raw/Convert.hs
View File

@@ -5,6 +5,8 @@ import PGF.Data
import PGF.Raw.Abstract
import PGF.BuildParser (buildParserInfo)
import PGF.Parsing.FCFG.Utilities
import qualified GF.Compile.GenerateFCFG as FCFG
import qualified GF.Compile.GeneratePMCFG as PMCFG
import qualified Data.Array as Array
import qualified Data.Map as Map
@@ -24,7 +26,7 @@ toPGF (Grm [
App "cat" cts
]),
App "concrete" ccs
]) = PGF {
]) = let pgf = PGF {
absname = mkCId a,
cncnames = [mkCId c | App c [] <- cs],
gflags = Map.fromAscList [(mkCId f,v) | App f [AStr v] <- gfs],
@@ -38,21 +40,27 @@ toPGF (Grm [
catfuns = Map.fromAscList
[(cat,[f | (f, (DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
in Abstr aflags funs cats catfuns,
concretes = Map.fromAscList [(mkCId lang, toConcr ts) | App lang ts <- ccs]
concretes = Map.fromAscList [(mkCId lang, toConcr pgf ts) | App lang ts <- ccs]
}
in pgf
where
toConcr :: [RExp] -> Concr
toConcr = foldl add (Concr {
cflags = Map.empty,
lins = Map.empty,
opers = Map.empty,
lincats = Map.empty,
lindefs = Map.empty,
printnames = Map.empty,
paramlincats = Map.empty,
parser = Nothing
})
toConcr :: PGF -> [RExp] -> Concr
toConcr pgf rexp =
let cnc = foldl add (Concr {cflags = Map.empty,
lins = Map.empty,
opers = Map.empty,
lincats = Map.empty,
lindefs = Map.empty,
printnames = Map.empty,
paramlincats = Map.empty,
parser = Just (buildParserOnDemand cnc) -- This thunk will be overwritten if there is a parser
-- compiled in the PGF file. We use lazy evaluation here
-- to make sure that buildParserOnDemand is called only
-- if it is needed.
}) rexp
in cnc
where
add :: Concr -> RExp -> Concr
add cnc (App "flags" ts) = cnc { cflags = Map.fromAscList [(mkCId f,v) | App f [AStr v] <- ts] }
@@ -64,6 +72,12 @@ toConcr = foldl add (Concr {
add cnc (App "param" ts) = cnc { paramlincats = mkTermMap ts }
add cnc (App "parser" ts) = cnc { parser = Just (toPInfo ts) }
buildParserOnDemand cnc = buildParserInfo fcfg
where
fcfg
| Map.lookup (mkCId "erasing") (cflags cnc) == Just "on" = PMCFG.convertConcrete (abstract pgf) cnc
| otherwise = FCFG.convertConcrete (abstract pgf) cnc
toPInfo :: [RExp] -> ParserInfo
toPInfo [App "rules" rs, App "startupcats" cs] = buildParserInfo (rules, cats)
where