"Committed_by_peb"

1 files changed, 123 insertions, 0 deletions

diff --git a/src/GF/Parsing/MCFG/Incremental.hs b/src/GF/Parsing/MCFG/Incremental.hs
new file mode 100644
index 000000000..897d365c9
--- /dev/null
+++ b/src/GF/Parsing/MCFG/Incremental.hs
@@ -0,0 +1,123 @@
+{-- Module --------------------------------------------------------------------
+  Filename:    IncrementalParse.hs
+  Author:      Håkan Burden
+  Time-stamp:  <2005-04-18, 15:07>
+
+  Description: An agenda-driven implementation of the incremental algorithm 4.6
+               that handles erasing and suppressing MCFG.
+               As described in Ljunglöf (2004)   
+------------------------------------------------------------------------------}
+
+module IncrementalParse where
+
+
+-- Haskell
+import List
+
+-- GF modules
+import Examples
+import GeneralChart
+import MCFGrammar
+import MCFParser
+import Parser
+import Range
+import Nondet
+
+
+{-- Datatypes -----------------------------------------------------------------
+  IChart: A RedBlackMap with Items and Keys
+  Item   : One kind of Item since the Passive Items not necessarily need to be 
+           saturated iow, they can still have rows to recognize. 
+  IKey  :  
+------------------------------------------------------------------------------}
+
+type IChart n c l = ParseChart (Item n c l) (IKey c l) 
+
+data Item   n c l = Active (AbstractRule n c) 
+                           (RangeRec l) 
+			   Range 
+			   (Lin c l Range) 
+			   (LinRec c l Range) 
+			   [RangeRec l]
+--		  | Passive (AbstractRule n c) 
+--		            (RangeRec l) 
+--			    [RangeRec l]
+		    deriving (Eq, Ord, Show)
+
+data IKey     c l = Act c l Int
+--		  | ActE l
+                  | Pass c l Int
+--		  | Pred l
+		  | Useless
+		    deriving (Eq, Ord, Show)
+
+keyof :: Item n c l -> IKey c l
+keyof (Active _ _ (Range (_,j)) (Lin _ ((Cat (next,lbl,_)):_)) _ _) 
+    = Act next lbl j
+keyof (Active (_, cat, _) found (Range (i,_)) (Lin lbl []) _ _) 
+    = Pass cat lbl i 
+keyof _                                                       
+    = Useless
+
+
+{-- Parsing -------------------------------------------------------------------
+  recognize: 
+  parse    : Builds a chart from the initial agenda, given by prediction, and
+             the inference rules 
+  keyof    : Given an Item returns an appropriate Key for the Chart
+------------------------------------------------------------------------------}
+
+recognize mcfg toks = chartMember (parse mcfg toks) item (keyof item)
+    where n = length toks
+	  n2 = n `div` 2
+	  item = Active ("f",S,[A]) 
+		 [] (Range (0, n)) (Lin "s" []) []
+		 [[("p", Range (0, n2)), ("q", Range (n2, n))]]
+
+
+parse :: (Ord n, Ord c, Ord l, Eq t) => Grammar n c l t -> [t] -> IChart n c l
+parse mcfg toks = buildChart keyof [complete ntoks, scan, combine] (predict mcfg toks ntoks)
+    where ntoks = length toks
+
+complete ::  (Ord n, Ord c, Ord l) => Int -> IChart n c l
+	 -> Item n c l -> [Item n c l]
+complete ntoks _ (Active rule found rng@(Range (_,j)) (Lin l []) lins recs) = 
+    [ Active rule (found ++ [(l, rng)]) (Range (k,k)) lin lins' recs  |
+      (lin, lins') <- select lins,
+      k <- [j .. ntoks] ]
+complete _ _ _ = []
+
+
+predict :: (Eq n, Eq c, Eq l, Eq t) => Grammar n c l t -> [t] -> Int -> [Item n c l]
+predict mcfg toks n = [ Active (f, c, rhs) [] (Range (k,k)) lin' lins'' daughters |
+		 	Rule c rhs lins f <- mcfg,
+			let daughters = replicate (length rhs) [],
+			lins' <- solutions $ rangeRestRec toks lins, 
+			(lin', lins'') <- select lins',
+			k <- [0..n] ]
+
+
+scan :: (Ord n, Ord c, Ord l) => IChart n c l -> Item n c l -> [Item n c l]
+scan _ (Active rule found rng (Lin l (Tok rng':syms)) lins recs) = 
+    [ Active rule found rng'' (Lin l syms) lins recs | 
+      rng'' <- solutions $ concRanges rng rng' ]
+scan _ _            = []
+
+
+combine :: (Ord n, Ord c, Ord l) => IChart n c l -> Item n c l -> [Item n c l]
+combine chart (Active rule found rng@(Range (_,j)) (Lin l ((Cat (c,r,d)):syms)) lins recs) = 
+    [ Active rule found rng'' (Lin l syms) lins (replaceRec recs d (found' ++ [(l',rng')])) |
+      Active _ found' rng' (Lin l' []) _ _ <-  chartLookup chart (Pass c r j),
+      subsumes (recs !! d) (found' ++ [(l',rng')]),
+      rng'' <- solutions $ concRanges rng rng' ] 
+combine chart (Active (_,c,_) found rng'@(Range (i,_)) (Lin l []) _ _) = 
+    [ Active rule found' rng'' (Lin l' syms) lins (replaceRec recs d (found ++ [(l,rng')])) |
+      Active rule found' rng (Lin l' ((Cat (c,r,d)):syms)) lins recs
+            <- chartLookup chart (Act c l i),
+      subsumes (recs !! d) (found ++ [(l,rng')]),
+      rng'' <- solutions $ concRanges rng rng' ]
+combine _ _ = [] 
+
+
+
+