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

corrected bottomup FCFG parsing

Browse Source
This commit is contained in:
peb
2006-06-07 16:16:17 +00:00
parent 643507e4f3
commit 8bee2d7def
2 changed files with 32 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
src/GF/Parsing/FCFG/Active.hs
View File

@@ -23,12 +23,8 @@ import GF.Infra.Ident
import GF.Parsing.FCFG.Range import GF.Parsing.FCFG.Range
import GF.Parsing.FCFG.PInfo import GF.Parsing.FCFG.PInfo
import GF.System.Tracing
import Control.Monad (guard) import Control.Monad (guard)
import GF.Infra.Print
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
@@ -44,8 +40,8 @@ parse strategy pinfo starts toks =
let FRule (Abs cat rhs fun) _ = allRules pinfo ! ruleid ] let FRule (Abs cat rhs fun) _ = allRules pinfo ! ruleid ]
where chart = process strategy pinfo toks axioms emptyXChart where chart = process strategy pinfo toks axioms emptyXChart
axioms | isBU strategy = terminal pinfo toks ++ initialScan pinfo toks axioms | isBU strategy = initialBU pinfo toks
| isTD strategy = initial pinfo starts toks | isTD strategy = initialTD pinfo starts toks
isBU s = s=="b" isBU s = s=="b"
isTD s = s=="t" isTD s = s=="t"
@@ -149,10 +145,9 @@ listXChartFinal (XChart actives finals) = chartList finals
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Earley -- -- Earley --
-- anropas med alla startkategorier -- called with all starting categories
initial :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> [c] -> Input t -> [Item] initialTD :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> [c] -> Input t -> [Item]
initial pinfo starts toks = initialTD pinfo starts toks =
tracePrt "MCFG.Active (Earley) - initial rules" (prt . length) $
do cat <- starts do cat <- starts
ruleid <- topdownRules pinfo ? cat ruleid <- topdownRules pinfo ? cat
let FRule abs lins = allRules pinfo ! ruleid let FRule abs lins = allRules pinfo ! ruleid
@@ -162,23 +157,24 @@ initial pinfo starts toks =
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Kilbury -- -- Kilbury --
terminal :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> Input t -> [Item] -- terminal :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> Input t -> [Item]
terminal pinfo toks = -- terminal pinfo toks = $
tracePrt "MCFG.Active (Kilbury) - initial terminal rules" (prt . length) $ -- tracePrt "MCFG.Active (Kilbury) - initial terminal rules" (prt . length) $
do ruleid <- emptyRules pinfo -- do ruleid <- emptyRules pinfo
let FRule abs lins = allRules pinfo ! ruleid -- let FRule abs lins = allRules pinfo ! ruleid
rrec <- mapM (rangeRestSyms toks EmptyRange . elems) (elems lins) -- rrec <- mapM (rangeRestSyms toks EmptyRange . elems) (elems lins)
return $ Final ruleid rrec [] -- return $ Final ruleid rrec []
where -- where
rangeRestSyms toks rng [] = return rng -- rangeRestSyms toks rng [] = return rng
rangeRestSyms toks rng (FSymTok tok:syms) = do (i,j) <- inputToken toks ? tok -- rangeRestSyms toks rng (FSymTok tok:syms) = do (i,j) <- inputToken toks ? tok
rng' <- concatRange rng (makeRange i j) -- rng' <- concatRange rng (makeRange i j)
rangeRestSyms toks rng' syms -- rangeRestSyms toks rng' syms
initialScan :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> Input t -> [Item] initialBU :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> Input t -> [Item]
initialScan pinfo toks = initialBU pinfo toks =
tracePrt "MCFG.Active (Kilbury) - initial scanned rules" (prt . length) $
do tok <- aElems (inputToken toks) do tok <- aElems (inputToken toks)
ruleid <- leftcornerTokens pinfo ? tok ruleid <- leftcornerTokens pinfo ? tok ++
epsilonRules pinfo
let FRule abs lins = allRules pinfo ! ruleid let FRule abs lins = allRules pinfo ! ruleid
return $ Active ruleid [] EmptyRange 0 0 (emptyChildren abs) return $ Active ruleid [] EmptyRange 0 0 (emptyChildren abs)

14
src/GF/Parsing/FCFG/PInfo.hs
View File

@@ -47,7 +47,9 @@ data FCFPInfo c n t
= FCFPInfo { allRules :: Array RuleId (FCFRule c n t) = FCFPInfo { allRules :: Array RuleId (FCFRule c n t)
, topdownRules :: Assoc c (SList RuleId) , topdownRules :: Assoc c (SList RuleId)
-- ^ used in 'GF.Parsing.MCFG.Active' (Earley): -- ^ used in 'GF.Parsing.MCFG.Active' (Earley):
, emptyRules :: [RuleId] -- , emptyRules :: [RuleId]
, epsilonRules :: [RuleId]
-- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
, leftcornerCats :: Assoc c (SList RuleId) , leftcornerCats :: Assoc c (SList RuleId)
, leftcornerTokens :: Assoc t (SList RuleId) , leftcornerTokens :: Assoc t (SList RuleId)
-- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury): -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
@@ -77,7 +79,8 @@ buildFCFPInfo grammar =
tracePrt "MCFG.PInfo - parser info" (prt) $ tracePrt "MCFG.PInfo - parser info" (prt) $
FCFPInfo { allRules = allrules FCFPInfo { allRules = allrules
, topdownRules = topdownrules , topdownRules = topdownrules
, emptyRules = emptyrules -- , emptyRules = emptyrules
, epsilonRules = epsilonrules
, leftcornerCats = leftcorncats , leftcornerCats = leftcorncats
, leftcornerTokens = leftcorntoks , leftcornerTokens = leftcorntoks
, grammarCats = grammarcats , grammarCats = grammarcats
@@ -85,7 +88,9 @@ buildFCFPInfo grammar =
where allrules = listArray (0,length grammar-1) grammar where allrules = listArray (0,length grammar-1) grammar
topdownrules = accumAssoc id [(cat, ruleid) | (ruleid, FRule (Abs cat _ _) _) <- assocs allrules] topdownrules = accumAssoc id [(cat, ruleid) | (ruleid, FRule (Abs cat _ _) _) <- assocs allrules]
emptyrules = [ruleid | (ruleid, FRule (Abs _ [] _) _) <- assocs allrules] -- emptyrules = [ruleid | (ruleid, FRule (Abs _ [] _) _) <- assocs allrules]
epsilonrules = [ ruleid | (ruleid, FRule _ lins) <- assocs allrules,
not (inRange (bounds (lins ! 0)) 0) ]
leftcorncats = accumAssoc id leftcorncats = accumAssoc id
[ (fromJust (getLeftCornerCat lins), ruleid) | [ (fromJust (getLeftCornerCat lins), ruleid) |
(ruleid, FRule _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ] (ruleid, FRule _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ]
@@ -100,7 +105,8 @@ buildFCFPInfo grammar =
instance (Ord c, Ord n, Ord t) => Print (FCFPInfo c n t) where instance (Ord c, Ord n, Ord t) => Print (FCFPInfo c n t) 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 ++
"; epsilonRules=" ++ sl epsilonRules ++
"; lcCats=" ++ sla leftcornerCats ++ "; lcCats=" ++ sla leftcornerCats ++
"; lcTokens=" ++ sla leftcornerTokens ++ "; lcTokens=" ++ sla leftcornerTokens ++
"; categories=" ++ sl grammarCats ++ "; categories=" ++ sl grammarCats ++