move GF.Parsing.FCFG.PInfo to GF.GFCC.BuildParser and rename FCFPInfo to ParserInfo

This commit is contained in:
krasimir
2008-05-29 12:27:26 +00:00
parent 97569244af
commit 7fc0aec243
9 changed files with 69 additions and 71 deletions

View File

@@ -34,6 +34,7 @@ library
GF.GFCC.Macros GF.GFCC.Macros
GF.GFCC.Generate GF.GFCC.Generate
GF.GFCC.Linearize GF.GFCC.Linearize
GF.GFCC.BuildParser
GF.Command.LexGFShell GF.Command.LexGFShell
GF.Command.AbsGFShell GF.Command.AbsGFShell
GF.Command.PrintGFShell GF.Command.PrintGFShell
@@ -46,7 +47,6 @@ library
GF.Data.Assoc GF.Data.Assoc
GF.Infra.PrintClass GF.Infra.PrintClass
GF.Formalism.Utilities GF.Formalism.Utilities
GF.Parsing.FCFG.PInfo
GF.Parsing.FCFG.Active GF.Parsing.FCFG.Active
GF.GFCC.Raw.ConvertGFCC GF.GFCC.Raw.ConvertGFCC
GF.Data.ErrM GF.Data.ErrM
@@ -99,7 +99,7 @@ executable gf3
GF.GFCC.Raw.ParGFCCRaw GF.GFCC.Raw.ParGFCCRaw
GF.GFCC.Raw.PrintGFCCRaw GF.GFCC.Raw.PrintGFCCRaw
GF.Formalism.Utilities GF.Formalism.Utilities
GF.Parsing.FCFG.PInfo GF.GFCC.BuildParser
GF.GFCC.DataGFCC GF.GFCC.DataGFCC
GF.Parsing.FCFG.Active GF.Parsing.FCFG.Active
GF.GFCC.Raw.ConvertGFCC GF.GFCC.Raw.ConvertGFCC

View File

@@ -8,6 +8,7 @@ import qualified GF.GFCC.DataGFCC as C
import qualified GF.GFCC.DataGFCC as D import qualified GF.GFCC.DataGFCC as D
import GF.GFCC.CId import GF.GFCC.CId
import GF.GFCC.PrintGFCC import GF.GFCC.PrintGFCC
import GF.GFCC.BuildParser (buildParserInfo)
import GF.Grammar.Predef import GF.Grammar.Predef
import GF.Grammar.PrGrammar import GF.Grammar.PrGrammar
import GF.Grammar.Grammar import GF.Grammar.Grammar
@@ -19,7 +20,6 @@ import qualified GF.Infra.Modules as M
import qualified GF.Infra.Option as O import qualified GF.Infra.Option as O
import GF.Compile.GenerateFCFG (convertConcrete) import GF.Compile.GenerateFCFG (convertConcrete)
import GF.Parsing.FCFG.PInfo (buildFCFPInfo)
import GF.Infra.Ident import GF.Infra.Ident
import GF.Infra.Option import GF.Infra.Option
import GF.Data.Operations import GF.Data.Operations
@@ -54,7 +54,7 @@ mkCanon2gfcc opts cnc gr =
addParsers :: D.GFCC -> D.GFCC addParsers :: D.GFCC -> D.GFCC
addParsers gfcc = gfcc { D.concretes = Map.map conv (D.concretes gfcc) } addParsers gfcc = gfcc { D.concretes = Map.map conv (D.concretes gfcc) }
where where
conv cnc = cnc { D.parser = Just (buildFCFPInfo (convertConcrete (D.abstract gfcc) cnc)) } conv cnc = cnc { D.parser = Just (buildParserInfo (convertConcrete (D.abstract gfcc) cnc)) }
-- Generate GFCC from GFCM. -- Generate GFCC from GFCM.
-- this assumes a grammar translated by canon2canon -- this assumes a grammar translated by canon2canon

View File

@@ -7,7 +7,7 @@
-- FCFG parsing, parser information -- FCFG parsing, parser information
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Parsing.FCFG.PInfo where module GF.GFCC.BuildParser where
import GF.Infra.PrintClass import GF.Infra.PrintClass
import GF.Formalism.Utilities import GF.Formalism.Utilities
@@ -22,17 +22,6 @@ import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Debug.Trace 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 -- parser information
@@ -53,9 +42,9 @@ getLeftCornerCat (FRule _ _ args _ lins)
where where
syms = lins ! 0 syms = lins ! 0
buildFCFPInfo :: FGrammar -> FCFPInfo buildParserInfo :: FGrammar -> ParserInfo
buildFCFPInfo (grammar,startup) = -- trace (unlines [prt (x,Set.toList set) | (x,set) <- Map.toList leftcornFilter]) $ buildParserInfo (grammar,startup) = -- trace (unlines [prt (x,Set.toList set) | (x,set) <- Map.toList leftcornFilter]) $
FCFPInfo { allRules = allrules ParserInfo { allRules = allrules
, topdownRules = topdownrules , topdownRules = topdownrules
-- , emptyRules = emptyrules -- , emptyRules = emptyrules
, epsilonRules = epsilonrules , epsilonRules = epsilonrules
@@ -75,13 +64,11 @@ buildFCFPInfo (grammar,startup) = -- trace (unlines [prt (x,Set.toList set) | (x
grammarcats = aElems topdownrules grammarcats = aElems topdownrules
grammartoks = nubsort [t | (FRule _ _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin] 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 -- pretty-printing of statistics
instance Print FCFPInfo where instance Print ParserInfo where
prt pI = "[ allRules=" ++ sl (elems . allRules) ++ prt pI = "[ allRules=" ++ sl (elems . allRules) ++
"; tdRules=" ++ sla topdownRules ++ "; tdRules=" ++ sla topdownRules ++
-- "; emptyRules=" ++ sl emptyRules ++ -- "; emptyRules=" ++ sl emptyRules ++

View File

@@ -35,7 +35,7 @@ data Concr = Concr {
lindefs :: Map.Map CId Term, -- lin default of a cat lindefs :: Map.Map CId Term, -- lin default of a cat
printnames :: Map.Map CId Term, -- printname of a cat or a fun printnames :: Map.Map CId Term, -- printname of a cat or a fun
paramlincats :: Map.Map CId Term, -- lin type of cat, with printable param names paramlincats :: Map.Map CId Term, -- lin type of cat, with printable param names
parser :: Maybe FCFPInfo -- parser parser :: Maybe ParserInfo -- parser
} }
data Type = data Type =
@@ -100,8 +100,8 @@ data FRule = FRule CId [Profile] [FCat] FCat (Array FIndex (Array FPointPos
type RuleId = Int type RuleId = Int
data FCFPInfo data ParserInfo
= FCFPInfo { allRules :: Array RuleId FRule = ParserInfo { allRules :: Array RuleId FRule
, topdownRules :: Assoc FCat [RuleId] , topdownRules :: Assoc FCat [RuleId]
-- ^ used in 'GF.Parsing.MCFG.Active' (Earley): -- ^ used in 'GF.Parsing.MCFG.Active' (Earley):
-- , emptyRules :: [RuleId] -- , emptyRules :: [RuleId]

View File

@@ -85,7 +85,7 @@ children :: JS.Ident
children = JS.Ident "cs" children = JS.Ident "cs"
-- Parser -- Parser
parser2js :: String -> FCFPInfo -> [JS.Expr] parser2js :: String -> ParserInfo -> [JS.Expr]
parser2js start p = [new "Parser" [JS.EStr start, parser2js start p = [new "Parser" [JS.EStr start,
JS.EArray $ map frule2js (Array.elems (allRules p)), JS.EArray $ map frule2js (Array.elems (allRules p)),
JS.EObj $ map cats (Map.assocs (startupCats p))]] JS.EObj $ map cats (Map.assocs (startupCats p))]]

View File

@@ -2,10 +2,10 @@ module GF.GFCC.Macros where
import GF.GFCC.CId import GF.GFCC.CId
import GF.GFCC.DataGFCC import GF.GFCC.DataGFCC
import GF.Parsing.FCFG.PInfo (fcfPInfoToFGrammar)
import GF.Infra.PrintClass import GF.Infra.PrintClass
import Control.Monad import Control.Monad
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Array as Array
import Data.Maybe import Data.Maybe
import Data.List import Data.List
@@ -31,11 +31,14 @@ lookType :: GFCC -> CId -> Type
lookType gfcc f = lookType gfcc f =
fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract gfcc)) fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract gfcc))
lookParser :: GFCC -> CId -> Maybe FCFPInfo lookParser :: GFCC -> CId -> Maybe ParserInfo
lookParser gfcc lang = parser $ lookMap (error "no lang") lang $ concretes gfcc lookParser gfcc lang = parser $ lookMap (error "no lang") lang $ concretes gfcc
lookFCFG :: GFCC -> CId -> Maybe FGrammar lookFCFG :: GFCC -> CId -> Maybe FGrammar
lookFCFG gfcc lang = fmap fcfPInfoToFGrammar $ lookParser gfcc lang lookFCFG gfcc lang = fmap toFGrammar $ lookParser gfcc lang
where
toFGrammar :: ParserInfo -> FGrammar
toFGrammar pinfo = (Array.elems (allRules pinfo), startupCats pinfo)
lookStartCat :: GFCC -> String lookStartCat :: GFCC -> String
lookStartCat gfcc = fromMaybe "S" $ msum $ Data.List.map (Map.lookup (mkCId "startcat")) lookStartCat gfcc = fromMaybe "S" $ msum $ Data.List.map (Map.lookup (mkCId "startcat"))

View File

@@ -3,10 +3,10 @@ module GF.GFCC.Raw.ConvertGFCC (toGFCC,fromGFCC) where
import GF.GFCC.CId import GF.GFCC.CId
import GF.GFCC.DataGFCC import GF.GFCC.DataGFCC
import GF.GFCC.Raw.AbsGFCCRaw import GF.GFCC.Raw.AbsGFCCRaw
import GF.GFCC.BuildParser (buildParserInfo)
import GF.Infra.PrintClass import GF.Infra.PrintClass
import GF.Formalism.Utilities import GF.Formalism.Utilities
import GF.Parsing.FCFG.PInfo (buildFCFPInfo)
import qualified Data.Array as Array import qualified Data.Array as Array
import qualified Data.Map as Map import qualified Data.Map as Map
@@ -66,8 +66,8 @@ toConcr = foldl add (Concr {
add cnc (App "param" ts) = cnc { paramlincats = mkTermMap ts } add cnc (App "param" ts) = cnc { paramlincats = mkTermMap ts }
add cnc (App "parser" ts) = cnc { parser = Just (toPInfo ts) } add cnc (App "parser" ts) = cnc { parser = Just (toPInfo ts) }
toPInfo :: [RExp] -> FCFPInfo toPInfo :: [RExp] -> ParserInfo
toPInfo [App "rules" rs, App "startupcats" cs] = buildFCFPInfo (rules, cats) toPInfo [App "rules" rs, App "startupcats" cs] = buildParserInfo (rules, cats)
where where
rules = map toFRule rs rules = map toFRule rs
cats = Map.fromList [(mkCId c, map expToInt fs) | App c fs <- cs] cats = Map.fromList [(mkCId c, map expToInt fs) | App c fs <- cs]
@@ -204,7 +204,7 @@ fromTerm e = case e of
-- ** Parsing info -- ** Parsing info
fromPInfo :: FCFPInfo -> RExp fromPInfo :: ParserInfo -> RExp
fromPInfo p = App "parser" [ fromPInfo p = App "parser" [
App "rules" [fromFRule rule | rule <- Array.elems (allRules p)], App "rules" [fromFRule rule | rule <- Array.elems (allRules p)],
App "startupcats" [App (prCId f) (map intToExp cs) | (f,cs) <- Map.toList (startupCats p)] App "startupcats" [App (prCId f) (map intToExp cs) | (f,cs) <- Map.toList (startupCats p)]

View File

@@ -8,7 +8,7 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Parsing.FCFG module GF.Parsing.FCFG
(parseFCF,buildFCFPInfo,FCFPInfo(..),makeFinalEdge) where (parseFCF,buildParserInfo,ParserInfo(..),makeFinalEdge) where
import GF.Data.SortedList import GF.Data.SortedList
import GF.Data.Assoc import GF.Data.Assoc
@@ -17,11 +17,11 @@ import GF.Infra.PrintClass
import GF.Formalism.Utilities import GF.Formalism.Utilities
import qualified GF.Parsing.FCFG.Active as Active import GF.Parsing.FCFG.Active
import GF.Parsing.FCFG.PInfo
import GF.GFCC.DataGFCC
import GF.GFCC.CId import GF.GFCC.CId
import GF.GFCC.DataGFCC
import GF.GFCC.BuildParser
import GF.GFCC.Macros import GF.GFCC.Macros
import GF.Data.ErrM import GF.Data.ErrM
@@ -34,7 +34,7 @@ import qualified Data.Map as Map
parseFCF :: parseFCF ::
String -> -- ^ parsing strategy String -> -- ^ parsing strategy
FCFPInfo -> -- ^ compiled grammar (fcfg) ParserInfo -> -- ^ compiled grammar (fcfg)
CId -> -- ^ starting category CId -> -- ^ starting category
[String] -> -- ^ input tokens [String] -> -- ^ input tokens
Err [Exp] -- ^ resulting GF terms Err [Exp] -- ^ resulting GF terms
@@ -51,8 +51,8 @@ parseFCF strategy pinfo startCat inString =
return $ map tree2term trees return $ map tree2term trees
where where
parseFCF :: String -> Err (FCFParser) parseFCF :: String -> Err (FCFParser)
parseFCF "bottomup" = Ok $ Active.parse "b" parseFCF "bottomup" = Ok $ parse "b"
parseFCF "topdown" = Ok $ Active.parse "t" parseFCF "topdown" = Ok $ parse "t"
parseFCF strat = Bad $ "FCFG parsing strategy not defined: " ++ strat parseFCF strat = Bad $ "FCFG parsing strategy not defined: " ++ strat
---------------------------------------------------------------------- ----------------------------------------------------------------------

View File

@@ -7,7 +7,7 @@
-- MCFG parsing, the active algorithm -- 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.GeneralDeduction
import GF.Data.Assoc import GF.Data.Assoc
@@ -20,8 +20,6 @@ import GF.Formalism.Utilities
import GF.Infra.PrintClass import GF.Infra.PrintClass
import GF.Parsing.FCFG.PInfo
import Control.Monad (guard) import Control.Monad (guard)
import qualified Data.List as List import qualified Data.List as List
@@ -32,6 +30,16 @@ import Data.Array
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- * parsing -- * 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 :: String -> FCFParser
parse strategy pinfo starts toks = xchart2syntaxchart chart pinfo parse strategy pinfo starts toks = xchart2syntaxchart chart pinfo
where chart = process strategy pinfo toks axioms emptyXChart where chart = process strategy pinfo toks axioms emptyXChart
@@ -42,12 +50,12 @@ isBU s = s=="b"
isTD s = s=="t" isTD s = s=="t"
-- used in prediction -- used in prediction
emptyChildren :: RuleId -> FCFPInfo -> SyntaxNode RuleId RangeRec emptyChildren :: RuleId -> ParserInfo -> SyntaxNode RuleId RangeRec
emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) []) emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) [])
where where
FRule _ _ rhs _ _ = allRules pinfo ! ruleid 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 [] chart = chart
process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks items $! univRule c item chart process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks items $! univRule c item chart
where where
@@ -129,7 +137,7 @@ insertXChart (XChart actives finals) item@(Final _ _) c =
lookupXChartAct (XChart actives finals) c = chartLookup actives c lookupXChartAct (XChart actives finals) c = chartLookup actives c
lookupXChartFinal (XChart actives finals) c = chartLookup finals 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 = xchart2syntaxchart (XChart actives finals) pinfo =
accumAssoc groupSyntaxNodes $ accumAssoc groupSyntaxNodes $
[ case node of [ case node of
@@ -141,7 +149,7 @@ xchart2syntaxchart (XChart actives finals) pinfo =
| (cat, Final found node) <- chartAssocs finals | (cat, Final found node) <- chartAssocs finals
] ]
literals :: FCFPInfo -> Input FToken -> [(FCat,Item)] literals :: ParserInfo -> Input FToken -> [(FCat,Item)]
literals pinfo toks = 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)] [let (c,node) = lexer t in (c,Final [rng] node) | (t,rngs) <- aAssocs (inputToken toks), rng <- rngs, not (t `elem` grammarToks pinfo)]
where where
@@ -157,7 +165,7 @@ literals pinfo toks =
-- Earley -- -- Earley --
-- called with all starting categories -- called with all starting categories
initialTD :: FCFPInfo -> [FCat] -> Input FToken -> [(FCat,Item)] initialTD :: ParserInfo -> [FCat] -> Input FToken -> [(FCat,Item)]
initialTD pinfo starts toks = initialTD pinfo starts toks =
do cat <- starts do cat <- starts
ruleid <- topdownRules pinfo ? cat ruleid <- topdownRules pinfo ? cat
@@ -167,7 +175,7 @@ initialTD pinfo starts toks =
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Kilbury -- -- Kilbury --
initialBU :: FCFPInfo -> Input FToken -> [(FCat,Item)] initialBU :: ParserInfo -> Input FToken -> [(FCat,Item)]
initialBU pinfo toks = initialBU pinfo toks =
do (tok,rngs) <- aAssocs (inputToken toks) do (tok,rngs) <- aAssocs (inputToken toks)
ruleid <- leftcornerTokens pinfo ? tok ruleid <- leftcornerTokens pinfo ? tok