From 55cb508a0f54a2461bf70a94ee04081c2ad1711c Mon Sep 17 00:00:00 2001 From: peb Date: Wed, 7 Jun 2006 16:16:17 +0000 Subject: [PATCH] corrected bottomup FCFG parsing --- src/GF/Parsing/FCFG/Active.hs | 48 ++++++++++++++++------------------- src/GF/Parsing/FCFG/PInfo.hs | 14 +++++++--- 2 files changed, 32 insertions(+), 30 deletions(-) diff --git a/src/GF/Parsing/FCFG/Active.hs b/src/GF/Parsing/FCFG/Active.hs index f4d31b9db..caae91573 100644 --- a/src/GF/Parsing/FCFG/Active.hs +++ b/src/GF/Parsing/FCFG/Active.hs @@ -23,12 +23,8 @@ import GF.Infra.Ident import GF.Parsing.FCFG.Range import GF.Parsing.FCFG.PInfo -import GF.System.Tracing - import Control.Monad (guard) -import GF.Infra.Print - import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Set as Set @@ -44,8 +40,8 @@ parse strategy pinfo starts toks = let FRule (Abs cat rhs fun) _ = allRules pinfo ! ruleid ] where chart = process strategy pinfo toks axioms emptyXChart - axioms | isBU strategy = terminal pinfo toks ++ initialScan pinfo toks - | isTD strategy = initial pinfo starts toks + axioms | isBU strategy = initialBU pinfo toks + | isTD strategy = initialTD pinfo starts toks isBU s = s=="b" isTD s = s=="t" @@ -149,10 +145,9 @@ listXChartFinal (XChart actives finals) = chartList finals ---------------------------------------------------------------------- -- Earley -- --- anropas med alla startkategorier -initial :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> [c] -> Input t -> [Item] -initial pinfo starts toks = - tracePrt "MCFG.Active (Earley) - initial rules" (prt . length) $ +-- called with all starting categories +initialTD :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> [c] -> Input t -> [Item] +initialTD pinfo starts toks = do cat <- starts ruleid <- topdownRules pinfo ? cat let FRule abs lins = allRules pinfo ! ruleid @@ -162,23 +157,24 @@ initial pinfo starts toks = ---------------------------------------------------------------------- -- Kilbury -- -terminal :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> Input t -> [Item] -terminal pinfo toks = - tracePrt "MCFG.Active (Kilbury) - initial terminal rules" (prt . length) $ - do ruleid <- emptyRules pinfo - let FRule abs lins = allRules pinfo ! ruleid - rrec <- mapM (rangeRestSyms toks EmptyRange . elems) (elems lins) - return $ Final ruleid rrec [] - where - rangeRestSyms toks rng [] = return rng - rangeRestSyms toks rng (FSymTok tok:syms) = do (i,j) <- inputToken toks ? tok - rng' <- concatRange rng (makeRange i j) - rangeRestSyms toks rng' syms +-- terminal :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> Input t -> [Item] +-- terminal pinfo toks = $ +-- tracePrt "MCFG.Active (Kilbury) - initial terminal rules" (prt . length) $ +-- do ruleid <- emptyRules pinfo +-- let FRule abs lins = allRules pinfo ! ruleid +-- rrec <- mapM (rangeRestSyms toks EmptyRange . elems) (elems lins) +-- return $ Final ruleid rrec [] +-- where +-- rangeRestSyms toks rng [] = return rng +-- rangeRestSyms toks rng (FSymTok tok:syms) = do (i,j) <- inputToken toks ? tok +-- rng' <- concatRange rng (makeRange i j) +-- rangeRestSyms toks rng' syms -initialScan :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> Input t -> [Item] -initialScan pinfo toks = - tracePrt "MCFG.Active (Kilbury) - initial scanned rules" (prt . length) $ +initialBU :: (Ord c, Ord n, Ord t) => FCFPInfo c n t -> Input t -> [Item] +initialBU pinfo toks = do tok <- aElems (inputToken toks) - ruleid <- leftcornerTokens pinfo ? tok + ruleid <- leftcornerTokens pinfo ? tok ++ + epsilonRules pinfo let FRule abs lins = allRules pinfo ! ruleid return $ Active ruleid [] EmptyRange 0 0 (emptyChildren abs) + diff --git a/src/GF/Parsing/FCFG/PInfo.hs b/src/GF/Parsing/FCFG/PInfo.hs index 5c3f910a0..e1126301a 100644 --- a/src/GF/Parsing/FCFG/PInfo.hs +++ b/src/GF/Parsing/FCFG/PInfo.hs @@ -47,7 +47,9 @@ data FCFPInfo c n t = FCFPInfo { allRules :: Array RuleId (FCFRule c n t) , topdownRules :: Assoc c (SList RuleId) -- ^ 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) , leftcornerTokens :: Assoc t (SList RuleId) -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury): @@ -77,7 +79,8 @@ buildFCFPInfo grammar = tracePrt "MCFG.PInfo - parser info" (prt) $ FCFPInfo { allRules = allrules , topdownRules = topdownrules - , emptyRules = emptyrules + -- , emptyRules = emptyrules + , epsilonRules = epsilonrules , leftcornerCats = leftcorncats , leftcornerTokens = leftcorntoks , grammarCats = grammarcats @@ -85,7 +88,9 @@ buildFCFPInfo grammar = where allrules = listArray (0,length grammar-1) grammar 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 [ (fromJust (getLeftCornerCat lins), ruleid) | (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 prt pI = "[ allRules=" ++ sl (elems . allRules) ++ "; tdRules=" ++ sla topdownRules ++ - "; emptyRules=" ++ sl emptyRules ++ + -- "; emptyRules=" ++ sl emptyRules ++ + "; epsilonRules=" ++ sl epsilonRules ++ "; lcCats=" ++ sla leftcornerCats ++ "; lcTokens=" ++ sla leftcornerTokens ++ "; categories=" ++ sl grammarCats ++