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

Redesign and opimize the incremental parser

Browse Source
This commit is contained in:
krasimir
2008-06-03 16:01:48 +00:00
parent 1647026506
commit a2f4baa78b
1 changed files with 68 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

119
src-3.0/PGF/Parsing/FCFG/Incremental.hs
View File

@@ -1,4 +1,4 @@
{-# OPTIONS -fbang-patterns #-} {-# LANGUAGE BangPatterns #-}
module PGF.Parsing.FCFG.Incremental module PGF.Parsing.FCFG.Incremental
( State ( State
, initState , initState
@@ -10,6 +10,8 @@ module PGF.Parsing.FCFG.Incremental
import Data.Array import Data.Array
import Data.Array.Base (unsafeAt) import Data.Array.Base (unsafeAt)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
import qualified Data.Set as Set import qualified Data.Set as Set
@@ -44,24 +46,42 @@ initState pinfo start =
Just ((fid,_), _) -> fid+1 Just ((fid,_), _) -> fid+1
Nothing -> 0 Nothing -> 0
in process (allRules pinfo) items (State MM.empty [] MM.empty Map.empty forest max_fid 0) in State (Chart MM.empty [] Map.empty forest max_fid 0)
(Set.fromList items)
nextState :: ParserInfo -> FToken -> State -> State nextState :: ParserInfo -> FToken -> State -> State
nextState pinfo t state = nextState pinfo t (State chart items) =
process (allRules pinfo) (tokens state MM.! t) state{ chart=MM.empty let (items1,chart1) = process add (allRules pinfo) (Set.toList items) (Set.empty,chart)
, charts=chart state : charts state chart2 = chart1{ active =MM.empty
, tokens=MM.empty , actives=active chart1 : actives chart1
, passive=Map.empty , passive=Map.empty
, currOffset=currOffset state+1 , offset =offset chart1+1
} }
in State chart2 items1
where
add tok item set
| tok == t = Set.insert item set
| otherwise = set
getCompletions :: State -> FToken -> [FToken] getCompletions :: ParserInfo -> FToken -> State -> Map.Map FToken State
getCompletions state w = getCompletions pinfo w (State chart items) =
[t | t <- MM.keys (tokens state), take (length w) t == w] let (map',chart1) = process add (allRules pinfo) (Set.toList items) (MM.empty,chart)
chart2 = chart1{ active =MM.empty
, actives=active chart1 : actives chart1
, passive=Map.empty
, offset =offset chart1+1
}
in fmap (State chart2) map'
where
add tok item map
| isPrefixOf w tok = fromMaybe map (MM.insert' tok item map)
| otherwise = map
extractExps :: ParserInfo -> CId -> State -> [Exp] extractExps :: ParserInfo -> CId -> State -> [Exp]
extractExps pinfo start st = exps extractExps pinfo start (State chart items) = exps
where where
(_,st) = process (\_ _ -> id) (allRules pinfo) (Set.toList items) ((),chart)
exps = nubsort $ do exps = nubsort $ do
c <- Map.findWithDefault [] start (startupCats pinfo) c <- Map.findWithDefault [] start (startupCats pinfo)
ruleid <- topdownRules pinfo ? c ruleid <- topdownRules pinfo ? c
@@ -77,46 +97,42 @@ extractExps pinfo start st = exps
args <- mapM go args args <- mapM go args
return (EApp fn args) return (EApp fn args)
process !rules [] state = state process fn !rules [] acc_chart = acc_chart
process !rules (item:items) state = process rules items $! univRule item state process fn !rules (item:items) acc_chart = process fn rules items $! univRule item acc_chart
where where
univRule (Active j lbl ppos ruleid args fid0) state univRule (Active j lbl ppos ruleid args fid0) acc_chart@(acc,chart)
| inRange (bounds lin) ppos = | inRange (bounds lin) ppos =
case unsafeAt lin ppos of case unsafeAt lin ppos of
FSymCat r d -> {-# SCC "COND11" #-} FSymCat r d -> let !fid = args !! d
let !fid = args !! d in case MM.insert' (AK fid r) item (active chart) of
in case MM.insert' (AK fid r) item (chart state) of Nothing -> acc_chart
Nothing -> state Just actCat -> (case Map.lookup (PK fid r k) (passive chart) of
Just actCat -> (case Map.lookup (PK fid r k) (passive state) of
Nothing -> id Nothing -> id
Just id -> process rules [Active j lbl (ppos+1) ruleid (updateAt d id args) fid0]) $ Just id -> process fn rules [Active j lbl (ppos+1) ruleid (updateAt d id args) fid0]) $
(case IntMap.lookup fid (forest state) of (case IntMap.lookup fid (forest chart) of
Nothing -> id Nothing -> id
Just set -> process rules (Set.fold (\(Passive ruleid args) -> (:) (Active k r 0 ruleid args fid)) [] set)) $ Just set -> process fn rules (Set.fold (\(Passive ruleid args) -> (:) (Active k r 0 ruleid args fid)) [] set)) $
state{chart=actCat} (acc,chart{active=actCat})
FSymTok tok -> {-# SCC "COND12" #-} FSymTok tok -> (fn tok (Active j lbl (ppos+1) ruleid args fid0) acc,chart)
case MM.insert' tok (Active j lbl (ppos+1) ruleid args fid0) (tokens state) of | otherwise = case Map.lookup (PK fid0 lbl j) (passive chart) of
Nothing -> state Nothing -> let fid = nextId chart
Just actTok -> state{tokens=actTok} in process fn rules [Active j' lbl (ppos+1) ruleid (updateAt d fid args) fidc
| otherwise = {-# SCC "COND2" #-} | Active j' lbl ppos ruleid args fidc <- ((active chart:actives chart) !! (k-j)) MM.! (AK fid0 lbl),
case Map.lookup (PK fid0 lbl j) (passive state) of let FSymCat _ d = unsafeAt (rhs ruleid lbl) ppos] $
Nothing -> let fid = nextId state (acc,chart{passive=Map.insert (PK fid0 lbl j) fid (passive chart)
in process rules [Active j' lbl (ppos+1) ruleid (updateAt d fid args) fidc ,forest =IntMap.insert fid (Set.singleton (Passive ruleid args)) (forest chart)
| Active j' lbl ppos ruleid args fidc <- ((chart state:charts state) !! (k-j)) MM.! (AK fid0 lbl), ,nextId =nextId chart+1
let FSymCat _ d = unsafeAt (rhs ruleid lbl) ppos] $ })
state{passive=Map.insert (PK fid0 lbl j) fid (passive state) Just id -> (acc,chart{forest = IntMap.insertWith Set.union id (Set.singleton (Passive ruleid args)) (forest chart)})
,forest =IntMap.insert fid (Set.singleton (Passive ruleid args)) (forest state)
,nextId =nextId state+1
}
Just id -> state{forest = IntMap.insertWith Set.union id (Set.singleton (Passive ruleid args)) (forest state)}
where where
!lin = rhs ruleid lbl !lin = rhs ruleid lbl
!k = currOffset state !k = offset chart
rhs ruleid lbl = unsafeAt lins lbl rhs ruleid lbl = unsafeAt lins lbl
where where
(FRule _ _ _ cat lins) = unsafeAt rules ruleid (FRule _ _ _ cat lins) = unsafeAt rules ruleid
updateAt :: Int -> a -> [a] -> [a]
updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs] updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs]
@@ -143,14 +159,15 @@ data PassiveKey
{-# UNPACK #-} !Int {-# UNPACK #-} !Int
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data State
= State data State = State Chart (Set.Set Active)
{ chart :: MM.MultiMap ActiveKey Active
, charts :: [MM.MultiMap ActiveKey Active] data Chart
, tokens :: MM.MultiMap FToken Active = Chart
, passive :: Map.Map PassiveKey FCat { active :: MM.MultiMap ActiveKey Active
, forest :: IntMap.IntMap (Set.Set Passive) , actives :: [MM.MultiMap ActiveKey Active]
, nextId :: {-# UNPACK #-} !FCat , passive :: Map.Map PassiveKey FCat
, currOffset :: {-# UNPACK #-} !Int , forest :: IntMap.IntMap (Set.Set Passive)
, nextId :: {-# UNPACK #-} !FCat
, offset :: {-# UNPACK #-} !Int
} }
deriving Show