summaryrefslogtreecommitdiff
path: root/src/GF/Parsing/MCFG/Incremental.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
commitb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch)
tree0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/Parsing/MCFG/Incremental.hs
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/Parsing/MCFG/Incremental.hs')
-rw-r--r--src/GF/Parsing/MCFG/Incremental.hs178
1 files changed, 0 insertions, 178 deletions
diff --git a/src/GF/Parsing/MCFG/Incremental.hs b/src/GF/Parsing/MCFG/Incremental.hs
deleted file mode 100644
index bd5b4114d..000000000
--- a/src/GF/Parsing/MCFG/Incremental.hs
+++ /dev/null
@@ -1,178 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer : PL
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/08/08 09:01:25 $
--- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
---
--- MCFG parsing, the incremental algorithm
------------------------------------------------------------------------------
-
-module GF.Parsing.MCFG.Incremental (parse, parseR) where
-
-import Data.List
-import Control.Monad (guard)
-
-import GF.Data.Utilities (select)
-import GF.Data.GeneralDeduction
-import GF.Data.Assoc
-
-import GF.Formalism.GCFG
-import GF.Formalism.MCFG
-import GF.Formalism.Utilities
-
-import GF.Parsing.MCFG.Range
-import GF.Parsing.MCFG.PInfo
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-----------------------------------------------------------------------
--- parsing
-
-parse :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
-parse pinfo starts toks =
- accumAssoc groupSyntaxNodes $
- [ ((cat, found), SNode fun (zip rhs rrecs)) |
- Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
- where chart = process pinfo toks ntoks
- ntoks = snd (inputBounds toks)
-
--- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
-parseR pinfo starts ntoks =
- accumAssoc groupSyntaxNodes $
- [ ((cat, found), SNode fun (zip rhs rrecs)) |
- Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
- where chart = processR pinfo ntoks
-
-process :: (Ord n, Ord c, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> Int -> IChart c n l
-process pinfo toks ntoks
- = tracePrt "MCFG.Incremental - chart size" prtSizes $
- buildChart keyof [complete ntoks, scan, combine, convert] (predict pinfo toks ntoks)
-
-processR :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> Int -> IChart c n l
-processR pinfo ntoks
- = tracePrt "MCFG.Incremental Range - chart size" prtSizes $
- buildChart keyof [complete ntoks, scan, combine, convert] (predictR pinfo ntoks)
-
-complete :: (Ord n, Ord c, Ord l) => Int -> IChart c n l -> Item c n l -> [Item c n l]
-complete ntoks _ (Active rule found rng (Lin l []) lins recs) =
- do (lin, lins') <- select lins
- k <- [minRange rng .. ntoks]
- return $ Active rule (found ++ [(l, rng)]) (Range (k,k)) lin lins' recs
-complete _ _ _ = []
-
-
-predict :: (Ord n, Ord c, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> Int -> [Item c n l]
-predict pinfo toks n =
- tracePrt "MCFG.Incremental - predicted rules" (prt . length) $
- do Rule abs@(Abs _ rhs _) (Cnc _ _ lins) <- rulesMatchingInput pinfo toks
- let daughters = replicate (length rhs) []
- lins' <- rangeRestRec toks lins
- (lin', lins'') <- select lins'
- k <- [0..n]
- return $ Active abs [] (Range (k,k)) lin' lins'' daughters
-
-
-predictR :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> Int -> [Item c n l]
-predictR pinfo n =
- tracePrt "MCFG.Incremental Range - predicted rules" (prt . length) $
- do Rule abs@(Abs _ rhs _) (Cnc _ _ lins) <- allRules pinfo
- let daughters = replicate (length rhs) []
- (lin, lins') <- select lins
- k <- [0..n]
- return $ Active abs [] (Range (k,k)) lin lins' daughters
-
-
-scan :: (Ord n, Ord c, Ord l) => IChart c n l -> Item c n l -> [Item c n l]
-scan _ (Active abs found rng (Lin l (Tok rng':syms)) lins recs) =
- do rng'' <- concatRange rng rng'
- return $ Active abs found rng'' (Lin l syms) lins recs
-scan _ _ = []
-
-
-combine :: (Ord n, Ord c, Ord l) => IChart c n l -> Item c n l -> [Item c n l]
-combine chart active@(Active _ _ rng (Lin _ (Cat (c,l,_):_)) _ _) =
- do passive <- chartLookup chart (Pass c l (maxRange rng))
- combine2 active passive
-combine chart passive@(Active (Abs c _ _) _ rng (Lin l []) _ _) =
- do active <- chartLookup chart (Act c l (minRange rng))
- combine2 active passive
-combine _ _ = []
-
-combine2 (Active abs found rng (Lin l (Cat (c,l',d):syms)) lins recs)
- (Active _ found' rng' _ _ _)
- = do rng'' <- concatRange rng rng'
- recs' <- unifyRec recs d found''
- return $ Active abs found rng'' (Lin l syms) lins recs'
- where found'' = found' ++ [(l',rng')]
-
-
-convert _ (Active rule found rng (Lin lbl []) [] recs) =
- return $ Final rule (found ++ [(lbl,rng)]) recs
-convert _ _ = []
-
-----------------------------------------------------------------------
--- type definitions
-
-type IChart c n l = ParseChart (Item c n l) (IKey c l)
-
-data Item c n l = Active (Abstract c n)
- (RangeRec l)
- Range
- (Lin c l Range)
- (LinRec c l Range)
- [RangeRec l]
- | Final (Abstract c n) (RangeRec l) [RangeRec l]
--- | Passive c (RangeRec l)
- deriving (Eq, Ord, Show)
-
-data IKey c l = Act c l Int
- | Pass c l Int
- | Useless
- | Fin
- deriving (Eq, Ord, Show)
-
-keyof :: Item c n l -> IKey c l
-keyof (Active _ _ rng (Lin _ (Cat (next,lbl,_):_)) _ _)
- = Act next lbl (maxRange rng)
-keyof (Active (Abs cat _ _) found rng (Lin lbl []) _ _)
- = Pass cat lbl (minRange rng)
-keyof (Final _ _ _) = Fin
-keyof _
- = Useless
-
-
-----------------------------------------------------------------------
--- for tracing purposes
-prtSizes chart = "final=" ++ show (length (chartLookup chart Fin)) ++
- ", passive=" ++ show (sum [length (chartLookup chart k) |
- k@(Pass _ _ _) <- chartKeys chart ]) ++
- ", active=" ++ show (sum [length (chartLookup chart k) |
- k@(Act _ _ _) <- chartKeys chart ]) ++
- ", useless=" ++ show (length (chartLookup chart Useless))
-
-prtChart chart = concat [ "\n*** KEY: " ++ prt k ++
- prtBefore "\n " (chartLookup chart k) |
- k <- chartKeys chart ]
-
-instance (Print c, Print n, Print l) => Print (Item c n l) where
- prt (Active abs found rng lin tofind children) =
- "? " ++ prt abs ++ ";\n\t" ++
- "{" ++ prtSep " " found ++ "} " ++ prt rng ++ " . " ++
- prt lin ++ "{" ++ prtSep " " tofind ++ "}" ++
- ( if null children then ";" else ";\n\t" ++
- "{" ++ prtSep "} {" (map (prtSep " ") children) ++ "}" )
--- prt (Passive c rrec) = "- " ++ prt c ++ "; {" ++ prtSep " " rrec ++ "}"
- prt (Final abs rr rrs) = ": " ++ prt abs ++ ";\n\t{" ++ prtSep " " rr ++ "}" ++
- ( if null rrs then ";" else ";\n\t" ++
- "{" ++ prtSep "} {" (map (prtSep " ") rrs) ++ "}" )
-
-instance (Print c, Print l) => Print (IKey c l) where
- prt (Act c l i) = "Active " ++ prt c ++ " " ++ prt l ++ " @ " ++ prt i
- prt (Pass c l i) = "Passive " ++ prt c ++ " " ++ prt l ++ " @ " ++ prt i
- prt (Fin) = "Final"
- prt (Useless) = "Useless"