From 055c0d0d5a5bb0dc75904fe53df7f2e4f5732a8f Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Wed, 21 May 2008 09:26:44 +0000
Subject: GF/src is now for 2.9, and the new sources are in src-3.0 - keep it
 this way until the release of GF 3

---
 src-3.0/GF/Parsing/FCFG/Incremental.hs | 107 +++++++++++++++++++++++++++++++++
 1 file changed, 107 insertions(+)
 create mode 100644 src-3.0/GF/Parsing/FCFG/Incremental.hs

(limited to 'src-3.0/GF/Parsing/FCFG/Incremental.hs')

diff --git a/src-3.0/GF/Parsing/FCFG/Incremental.hs b/src-3.0/GF/Parsing/FCFG/Incremental.hs
new file mode 100644
index 000000000..5ee77a061
--- /dev/null
+++ b/src-3.0/GF/Parsing/FCFG/Incremental.hs
@@ -0,0 +1,107 @@
+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)
-- 
cgit v1.2.3