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

back to breadth first search. Fixes the the "I am here" bug

Browse Source
This commit is contained in:
kr.angelov
2008-06-04 21:49:39 +00:00
parent b33b7aa339
commit 4606271031
1 changed files with 8 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -103,32 +103,36 @@ extractExps (State pinfo chart items) start = exps
return (EApp fn args) return (EApp fn args)
process fn !rules [] acc_chart = acc_chart process fn !rules [] acc_chart = acc_chart
process fn !rules (item:items) acc_chart = process fn rules items $! univRule item acc_chart process fn !rules (item:items) acc_chart = univRule item acc_chart
where where
univRule (Active j lbl ppos ruleid args fid0) acc_chart@(acc,chart) 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 -> let !fid = args !! d FSymCat r d -> let !fid = args !! d
in case MM.insert' (AK fid r) item (active chart) of in case MM.insert' (AK fid r) item (active chart) of
Nothing -> acc_chart Nothing -> process fn rules items $ acc_chart
Just actCat -> (case Map.lookup (PK fid r k) (passive chart) of Just actCat -> (case Map.lookup (PK fid r k) (passive chart) of
Nothing -> id Nothing -> id
Just id -> process fn 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 chart) of (case IntMap.lookup fid (forest chart) of
Nothing -> id Nothing -> id
Just set -> process fn 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)) $
process fn rules items $
(acc,chart{active=actCat}) (acc,chart{active=actCat})
FSymTok tok -> (fn tok (Active j lbl (ppos+1) ruleid args fid0) acc,chart) FSymTok tok -> process fn rules items $
(fn tok (Active j lbl (ppos+1) ruleid args fid0) acc,chart)
| otherwise = case Map.lookup (PK fid0 lbl j) (passive chart) of | otherwise = case Map.lookup (PK fid0 lbl j) (passive chart) of
Nothing -> let fid = nextId chart Nothing -> let fid = nextId chart
in process fn rules [Active j' lbl (ppos+1) ruleid (updateAt d fid args) fidc in process fn rules [Active j' lbl (ppos+1) ruleid (updateAt d fid args) fidc
| Active j' lbl ppos ruleid args fidc <- ((active chart:actives chart) !! (k-j)) MM.! (AK fid0 lbl), | Active j' lbl ppos ruleid args fidc <- ((active chart:actives chart) !! (k-j)) MM.! (AK fid0 lbl),
let FSymCat _ d = unsafeAt (rhs ruleid lbl) ppos] $ let FSymCat _ d = unsafeAt (rhs ruleid lbl) ppos] $
process fn rules items $
(acc,chart{passive=Map.insert (PK fid0 lbl j) fid (passive chart) (acc,chart{passive=Map.insert (PK fid0 lbl j) fid (passive chart)
,forest =IntMap.insert fid (Set.singleton (Passive ruleid args)) (forest chart) ,forest =IntMap.insert fid (Set.singleton (Passive ruleid args)) (forest chart)
,nextId =nextId chart+1 ,nextId =nextId chart+1
}) })
Just id -> (acc,chart{forest = IntMap.insertWith Set.union id (Set.singleton (Passive ruleid args)) (forest chart)}) Just id -> process fn rules items $
(acc,chart{forest = IntMap.insertWith Set.union id (Set.singleton (Passive ruleid args)) (forest chart)})
where where
!lin = rhs ruleid lbl !lin = rhs ruleid lbl
!k = offset chart !k = offset chart