forked from GitHub/gf-core
108 lines
4.8 KiB
Haskell
108 lines
4.8 KiB
Haskell
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 -> State
|
|
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 lbl 0 ruleid args cat)
|
|
|
|
forest = IntMap.fromListWith Set.union [(cat, Set.singleton (Passive ruleid args)) | (ruleid, FRule _ args cat _) <- assocs (allRules pinfo)]
|
|
|
|
max_fid = case IntMap.maxViewWithKey forest of
|
|
Just ((fid,_), _) -> fid+1
|
|
Nothing -> 0
|
|
|
|
in process pinfo items (State emptyChart [] emptyChart Map.empty forest max_fid 0)
|
|
|
|
nextState :: FCFPInfo -> FToken -> State -> State
|
|
nextState pinfo t state =
|
|
process pinfo (chartLookup (tokens state) t) state{ chart=emptyChart
|
|
, charts=chart state : charts state
|
|
, tokens=emptyChart
|
|
, passive=Map.empty
|
|
, currOffset=currOffset state+1
|
|
}
|
|
|
|
getCompletions :: State -> FToken -> [FToken]
|
|
getCompletions state w =
|
|
[t | t <- chartKeys (tokens state), take (length w) t == w]
|
|
|
|
process pinfo [] state = state
|
|
process pinfo (item@(Active j lbl ppos ruleid args fid0):xitems) state
|
|
| inRange (bounds lin) ppos =
|
|
case lin ! ppos of
|
|
FSymCat _ r d -> let fid = args !! d
|
|
in case chartInsert (chart state) item (fid,r) of
|
|
Nothing -> process pinfo xitems state
|
|
Just actCat -> let items = do exprs <- IntMap.lookup fid (forest state)
|
|
(Passive ruleid args) <- Set.toList exprs
|
|
return (Active k r 0 ruleid args fid)
|
|
`mplus`
|
|
do id <- Map.lookup (fid,r,k) (passive state)
|
|
return (Active j lbl (ppos+1) ruleid (updateAt d id args) fid0)
|
|
in process pinfo (xitems++items) state{chart=actCat}
|
|
FSymTok tok -> case chartInsert (tokens state) (Active j lbl (ppos+1) ruleid args fid0) tok of
|
|
Nothing -> process pinfo xitems state
|
|
Just actTok -> process pinfo xitems state{tokens=actTok}
|
|
| otherwise = case Map.lookup (fid0, lbl, j) (passive state) of
|
|
Nothing -> let fid = nextId state
|
|
items = do Active j' lbl ppos ruleid args fidc <- chartLookup ((chart state:charts state) !! (k-j)) (fid0,lbl)
|
|
let FSymCat _ _ d = rhs ruleid lbl ! ppos
|
|
return (Active j' lbl (ppos+1) ruleid (updateAt d fid args) fidc)
|
|
in process pinfo (xitems++items) state{passive=Map.insert (fid0, lbl, j) fid (passive state)
|
|
,forest =IntMap.insert fid (Set.singleton (Passive ruleid args)) (forest state)
|
|
,nextId =nextId state+1
|
|
}
|
|
Just id -> process pinfo xitems state{forest = IntMap.insertWith Set.union id (Set.singleton (Passive ruleid args)) (forest state)}
|
|
where
|
|
lin = rhs ruleid lbl
|
|
k = currOffset state
|
|
|
|
rhs ruleid lbl = lins ! lbl
|
|
where
|
|
(FRule _ _ cat lins) = allRules pinfo ! ruleid
|
|
|
|
updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs]
|
|
|
|
|
|
data Active
|
|
= Active Int FIndex FPointPos RuleId [FCat] FCat
|
|
deriving (Eq,Show,Ord)
|
|
data Passive
|
|
= Passive RuleId [FCat]
|
|
deriving (Eq,Ord,Show)
|
|
|
|
|
|
data State
|
|
= State
|
|
{ chart :: Chart
|
|
, charts :: [Chart]
|
|
, tokens :: ParseChart Active FToken
|
|
, passive :: Map.Map (FCat, FIndex, Int) FCat
|
|
, forest :: IntMap.IntMap (Set.Set Passive)
|
|
, nextId :: FCat
|
|
, currOffset :: Int
|
|
}
|
|
deriving Show
|
|
|
|
type Chart = ParseChart Active (FCat, FIndex)
|