GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

add experimental incremental parser for FCFG

Browse Source
This commit is contained in:
krasimir
2008-02-18 16:58:27 +00:00
parent c018498aba
commit 27df450a26
1 changed files with 115 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

115
src/GF/Parsing/FCFG/Incremental.hs Normal file
View File

@@ -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)