From a4bded9f3aa2cb4fe7344a8540a81ec7c1d81a63 Mon Sep 17 00:00:00 2001 From: krasimir Date: Mon, 18 Feb 2008 16:58:27 +0000 Subject: [PATCH] add experimental incremental parser for FCFG --- src/GF/Parsing/FCFG/Incremental.hs | 115 +++++++++++++++++++++++++++++ 1 file changed, 115 insertions(+) create mode 100644 src/GF/Parsing/FCFG/Incremental.hs diff --git a/src/GF/Parsing/FCFG/Incremental.hs b/src/GF/Parsing/FCFG/Incremental.hs new file mode 100644 index 000000000..d472a2f2f --- /dev/null +++ b/src/GF/Parsing/FCFG/Incremental.hs @@ -0,0 +1,115 @@ +module GF.Parsing.FCFG.Incremental where + +import Data.Array +import qualified Data.Map as Map +import qualified Data.IntMap as IntMap +import qualified Data.Set as Set +import Control.Monad + +import GF.Data.Assoc +import GF.Data.GeneralDeduction +import GF.Formalism.FCFG +import GF.Formalism.Utilities +import GF.Parsing.FCFG.PInfo +import GF.Parsing.FCFG.Range +import GF.GFCC.CId +import Debug.Trace + +initState :: FCFPInfo -> CId -> Chart +initState pinfo start = + let items = do + starts <- Map.lookup start (startupCats pinfo) + c <- starts + ruleid <- topdownRules pinfo ? c + let (FRule fn args cat lins) = allRules pinfo ! ruleid + lbl <- indices lins + return (Active 0 0 lbl 0 0 (App ruleid [0 | arg <- args])) + in process pinfo items (Chart emptyChart emptyChart emptyChart Map.empty IntMap.empty 1) + +nextState :: FCFPInfo -> FToken -> Chart -> Chart +nextState pinfo t chart = + let items = chartLookup (actTok chart) t + in process pinfo [Active j (k+1) lbl (ppos+1) fid expr | Active j k lbl ppos fid expr <- items] chart{actTok=emptyChart} + +getCompletions :: Chart -> FToken -> [FToken] +getCompletions chart w = + [t | t <- chartKeys (actTok chart), take (length w) t == w] + +process pinfo [] chart = chart +process pinfo (item:xitems) chart = univRule item chart + where + univRule item@(Active j k lbl ppos fid0 expr@(App ruleid args)) chart + | inRange (bounds lin) ppos = + case lin ! ppos of + FSymCat c r d -> case args !! d of + 0 -> case chartInsert (actCat chart) item (c,r,k) of + Nothing -> process pinfo xitems chart + Just actCat -> let items = do ruleid <- topdownRules pinfo ? c + let (FRule fn args cat lins) = allRules pinfo ! ruleid + return (Active k k r 0 0 (App ruleid [0 | arg <- args])) + `mplus` + do endings <- Map.lookup (c,r,k) (passive chart) + (k',id) <- Map.toList endings + return (Active j k' lbl (ppos+1) fid0 (App ruleid (updateAt d id args))) + in process pinfo (xitems++items) chart{actCat=actCat} + id -> case chartInsert (actTre chart) item (id,r,k) of + Nothing -> process pinfo xitems chart + Just actTre -> let items = do exprs <- IntMap.lookup id (forest chart) + App ruleid args <- Set.toList exprs + return (Active k k r 0 id (App ruleid args)) + in process pinfo (xitems++items) chart{actTre=actTre} + FSymTok tok -> case chartInsert (actTok chart) item tok of + Nothing -> process pinfo xitems chart + Just actTok -> process pinfo xitems chart{actTok=actTok} + | otherwise = let ffg fid chart = if fid0 == 0 + then let items = do Active j' k' lbl ppos fidc (App ruleid args) <- chartLookup (actCat chart) (cat,lbl,j) + let (FRule fn _ cat lins) = allRules pinfo ! ruleid + FSymCat c r d = lins ! lbl ! ppos + return (Active j' k lbl (ppos+1) fidc (App ruleid (updateAt d fid args))) + in process pinfo (xitems++items) chart + else let items = do Active j' k' lbl ppos fidc (App ruleid args) <- chartLookup (actTre chart) (fid0,lbl,j) + let (FRule fn _ cat lins) = allRules pinfo ! ruleid + FSymCat c r d = lins ! lbl ! ppos + return (Active j' k lbl (ppos+1) fidc (App ruleid (updateAt d fid args))) + in process pinfo (xitems++items) chart + + in case Map.lookup (cat, lbl, j) (passive chart) of + Nothing -> ffg (nextId chart) $ + chart{passive=Map.insert (cat, lbl, j) (Map.singleton k (nextId chart)) (passive chart) + ,forest =IntMap.insert (nextId chart) (Set.singleton expr) (forest chart) + ,nextId =nextId chart+1 + } + Just endings -> case Map.lookup k endings of + Nothing -> ffg (nextId chart) $ + chart{passive=Map.insert (cat, lbl, j) (Map.insert k (nextId chart) endings) (passive chart) + ,forest =IntMap.insert (nextId chart) (Set.singleton expr) (forest chart) + ,nextId =nextId chart+1 + } + Just id -> process pinfo xitems chart{forest = IntMap.insertWith Set.union id (Set.singleton expr) (forest chart)} + where + (FRule fn _ cat lins) = allRules pinfo ! ruleid + lin = lins ! lbl + + + +updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs] + +data Active + = Active Int Int FIndex FPointPos ForestId Expr + deriving (Eq,Show,Ord) + +data Chart + = Chart + { actCat :: ParseChart Active (FCat, FIndex, Int) + , actTre :: ParseChart Active (ForestId, FIndex, Int) + , actTok :: ParseChart Active FToken + , passive :: Map.Map (FCat, FIndex, Int) (Map.Map Int ForestId) + , forest :: IntMap.IntMap (Set.Set Expr) + , nextId :: ForestId + } + deriving Show + +type ForestId = Int +data Expr + = App RuleId [ForestId] + deriving (Eq,Ord,Show) \ No newline at end of file