forked from GitHub/gf-core
move GF.Parsing.FCFG.PInfo to GF.GFCC.BuildParser and rename FCFPInfo to ParserInfo
This commit is contained in:
krasimir
@@ -7,7 +7,7 @@
|
||||
-- MCFG parsing, the active algorithm
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module GF.Parsing.FCFG.Active (parse) where
|
||||
module GF.Parsing.FCFG.Active (FCFParser, parse, makeFinalEdge) where
|
||||
|
||||
import GF.Data.GeneralDeduction
|
||||
import GF.Data.Assoc
|
||||
@@ -20,8 +20,6 @@ import GF.Formalism.Utilities
|
||||
|
||||
import GF.Infra.PrintClass
|
||||
|
||||
import GF.Parsing.FCFG.PInfo
|
||||
|
||||
import Control.Monad (guard)
|
||||
|
||||
import qualified Data.List as List
|
||||
@@ -32,6 +30,16 @@ import Data.Array
|
||||
----------------------------------------------------------------------
|
||||
-- * parsing
|
||||
|
||||
makeFinalEdge cat 0 0 = (cat, [EmptyRange])
|
||||
makeFinalEdge cat i j = (cat, [makeRange i j])
|
||||
|
||||
-- | the list of categories = possible starting categories
|
||||
type FCFParser = ParserInfo
|
||||
-> [FCat]
|
||||
-> Input FToken
|
||||
-> SyntaxChart (CId,[Profile]) (FCat,RangeRec)
|
||||
|
||||
|
||||
parse :: String -> FCFParser
|
||||
parse strategy pinfo starts toks = xchart2syntaxchart chart pinfo
|
||||
where chart = process strategy pinfo toks axioms emptyXChart
|
||||
@@ -42,12 +50,12 @@ isBU s = s=="b"
|
||||
isTD s = s=="t"
|
||||
|
||||
-- used in prediction
|
||||
emptyChildren :: RuleId -> FCFPInfo -> SyntaxNode RuleId RangeRec
|
||||
emptyChildren :: RuleId -> ParserInfo -> SyntaxNode RuleId RangeRec
|
||||
emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) [])
|
||||
where
|
||||
FRule _ _ rhs _ _ = allRules pinfo ! ruleid
|
||||
|
||||
process :: String -> FCFPInfo -> Input FToken -> [(FCat,Item)] -> XChart FCat -> XChart FCat
|
||||
process :: String -> ParserInfo -> Input FToken -> [(FCat,Item)] -> XChart FCat -> XChart FCat
|
||||
process strategy pinfo toks [] chart = chart
|
||||
process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks items $! univRule c item chart
|
||||
where
|
||||
@@ -129,7 +137,7 @@ insertXChart (XChart actives finals) item@(Final _ _) c =
|
||||
lookupXChartAct (XChart actives finals) c = chartLookup actives c
|
||||
lookupXChartFinal (XChart actives finals) c = chartLookup finals c
|
||||
|
||||
xchart2syntaxchart :: XChart FCat -> FCFPInfo -> SyntaxChart (CId,[Profile]) (FCat,RangeRec)
|
||||
xchart2syntaxchart :: XChart FCat -> ParserInfo -> SyntaxChart (CId,[Profile]) (FCat,RangeRec)
|
||||
xchart2syntaxchart (XChart actives finals) pinfo =
|
||||
accumAssoc groupSyntaxNodes $
|
||||
[ case node of
|
||||
@@ -141,7 +149,7 @@ xchart2syntaxchart (XChart actives finals) pinfo =
|
||||
| (cat, Final found node) <- chartAssocs finals
|
||||
]
|
||||
|
||||
literals :: FCFPInfo -> Input FToken -> [(FCat,Item)]
|
||||
literals :: ParserInfo -> Input FToken -> [(FCat,Item)]
|
||||
literals pinfo toks =
|
||||
[let (c,node) = lexer t in (c,Final [rng] node) | (t,rngs) <- aAssocs (inputToken toks), rng <- rngs, not (t `elem` grammarToks pinfo)]
|
||||
where
|
||||
@@ -157,7 +165,7 @@ literals pinfo toks =
|
||||
-- Earley --
|
||||
|
||||
-- called with all starting categories
|
||||
initialTD :: FCFPInfo -> [FCat] -> Input FToken -> [(FCat,Item)]
|
||||
initialTD :: ParserInfo -> [FCat] -> Input FToken -> [(FCat,Item)]
|
||||
initialTD pinfo starts toks =
|
||||
do cat <- starts
|
||||
ruleid <- topdownRules pinfo ? cat
|
||||
@@ -167,7 +175,7 @@ initialTD pinfo starts toks =
|
||||
----------------------------------------------------------------------
|
||||
-- Kilbury --
|
||||
|
||||
initialBU :: FCFPInfo -> Input FToken -> [(FCat,Item)]
|
||||
initialBU :: ParserInfo -> Input FToken -> [(FCat,Item)]
|
||||
initialBU pinfo toks =
|
||||
do (tok,rngs) <- aAssocs (inputToken toks)
|
||||
ruleid <- leftcornerTokens pinfo ? tok
|
||||
|
||||
@@ -1,97 +0,0 @@
|
||||
---------------------------------------------------------------------
|
||||
-- |
|
||||
-- Maintainer : Krasimir Angelov
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- FCFG parsing, parser information
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module GF.Parsing.FCFG.PInfo where
|
||||
|
||||
import GF.Infra.PrintClass
|
||||
import GF.Formalism.Utilities
|
||||
import GF.Data.SortedList
|
||||
import GF.Data.Assoc
|
||||
import GF.GFCC.CId
|
||||
import GF.GFCC.DataGFCC
|
||||
|
||||
import Data.Array
|
||||
import Data.Maybe
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import Debug.Trace
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- type declarations
|
||||
|
||||
-- | the list of categories = possible starting categories
|
||||
type FCFParser = FCFPInfo
|
||||
-> [FCat]
|
||||
-> Input FToken
|
||||
-> SyntaxChart (CId,[Profile]) (FCat,RangeRec)
|
||||
|
||||
makeFinalEdge cat 0 0 = (cat, [EmptyRange])
|
||||
makeFinalEdge cat i j = (cat, [makeRange i j])
|
||||
|
||||
------------------------------------------------------------
|
||||
-- parser information
|
||||
|
||||
getLeftCornerTok (FRule _ _ _ _ lins)
|
||||
| inRange (bounds syms) 0 = case syms ! 0 of
|
||||
FSymTok tok -> [tok]
|
||||
_ -> []
|
||||
| otherwise = []
|
||||
where
|
||||
syms = lins ! 0
|
||||
|
||||
getLeftCornerCat (FRule _ _ args _ lins)
|
||||
| inRange (bounds syms) 0 = case syms ! 0 of
|
||||
FSymCat _ d -> [args !! d]
|
||||
_ -> []
|
||||
| otherwise = []
|
||||
where
|
||||
syms = lins ! 0
|
||||
|
||||
buildFCFPInfo :: FGrammar -> FCFPInfo
|
||||
buildFCFPInfo (grammar,startup) = -- trace (unlines [prt (x,Set.toList set) | (x,set) <- Map.toList leftcornFilter]) $
|
||||
FCFPInfo { allRules = allrules
|
||||
, topdownRules = topdownrules
|
||||
-- , emptyRules = emptyrules
|
||||
, epsilonRules = epsilonrules
|
||||
, leftcornerCats = leftcorncats
|
||||
, leftcornerTokens = leftcorntoks
|
||||
, grammarCats = grammarcats
|
||||
, grammarToks = grammartoks
|
||||
, startupCats = startup
|
||||
}
|
||||
|
||||
where allrules = listArray (0,length grammar-1) grammar
|
||||
topdownrules = accumAssoc id [(cat, ruleid) | (ruleid, FRule _ _ _ cat _) <- assocs allrules]
|
||||
epsilonrules = [ ruleid | (ruleid, FRule _ _ _ _ lins) <- assocs allrules,
|
||||
not (inRange (bounds (lins ! 0)) 0) ]
|
||||
leftcorncats = accumAssoc id [ (cat, ruleid) | (ruleid, rule) <- assocs allrules, cat <- getLeftCornerCat rule ]
|
||||
leftcorntoks = accumAssoc id [ (tok, ruleid) | (ruleid, rule) <- assocs allrules, tok <- getLeftCornerTok rule ]
|
||||
grammarcats = aElems topdownrules
|
||||
grammartoks = nubsort [t | (FRule _ _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]
|
||||
|
||||
fcfPInfoToFGrammar :: FCFPInfo -> FGrammar
|
||||
fcfPInfoToFGrammar pinfo = (elems (allRules pinfo), startupCats pinfo)
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- pretty-printing of statistics
|
||||
|
||||
instance Print FCFPInfo where
|
||||
prt pI = "[ allRules=" ++ sl (elems . allRules) ++
|
||||
"; tdRules=" ++ sla topdownRules ++
|
||||
-- "; emptyRules=" ++ sl emptyRules ++
|
||||
"; epsilonRules=" ++ sl epsilonRules ++
|
||||
"; lcCats=" ++ sla leftcornerCats ++
|
||||
"; lcTokens=" ++ sla leftcornerTokens ++
|
||||
"; categories=" ++ sl grammarCats ++
|
||||
" ]"
|
||||
|
||||
where sl f = show $ length $ f pI
|
||||
sla f = let (as, bs) = unzip $ aAssocs $ f pI
|
||||
in show (length as) ++ "/" ++ show (length (concat bs))
|
||||
|
||||
Reference in New Issue
Block a user