summaryrefslogtreecommitdiff
path: root/src/GF/Parsing/MCFG/Active2.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/Active2.hs
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/Parsing/MCFG/Active2.hs')
-rw-r--r--src/GF/Parsing/MCFG/Active2.hs237
1 files changed, 0 insertions, 237 deletions
diff --git a/src/GF/Parsing/MCFG/Active2.hs b/src/GF/Parsing/MCFG/Active2.hs
deleted file mode 100644
index 7ad8627bc..000000000
--- a/src/GF/Parsing/MCFG/Active2.hs
+++ /dev/null
@@ -1,237 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer : PL
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/08/08 09:01:25 $
--- > CVS $Author: peb $
--- > CVS $Revision: 1.2 $
---
--- MCFG parsing, the active algorithm (alternative version)
------------------------------------------------------------------------------
-
-module GF.Parsing.MCFG.Active2 (parse) where
-
-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 Control.Monad (guard)
-
-import GF.Infra.Print
-
-----------------------------------------------------------------------
--- * parsing
-
---parse :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
-parse strategy 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 strategy pinfo starts toks
-
-process :: (Ord n, Ord c, Ord l, Ord t) =>
- String -> MCFPInfo c n l t -> [c] -> Input t -> AChart c n l t
-process strategy pinfo starts toks
- = tracePrt "MCFG.Active - chart size" prtSizes $
- buildChart keyof (complete : combine : convert : rules) axioms
- where rules | isNil strategy = [scan toks]
- | isBU strategy = [scan toks, predictKilbury pinfo toks]
- | isTD strategy = [scan toks, predictEarley pinfo toks]
- axioms | isNil strategy = predict pinfo toks
- | isBU strategy = terminal pinfo toks ++ initialScan pinfo toks
- | isTD strategy = initial pinfo starts toks
-
-isNil s = s=="n"
-isBU s = s=="b"
-isTD s = s=="t"
-
--- used in prediction
-emptyChildren :: Abstract c n -> [RangeRec l]
-emptyChildren (Abs _ rhs _) = replicate (length rhs) []
-
-makeMaxRange (Range (_, j)) = Range (j, j)
-makeMaxRange EmptyRange = EmptyRange
-
-
-----------------------------------------------------------------------
--- * inference rules
-
--- completion
-complete :: (Ord c, Ord n, Ord l, Ord t) => AChart c n l t -> Item c n l t -> [Item c n l t]
-complete _ (Active rule found rng (Lin l []) (lin:lins) recs) =
- return $ Active rule (found ++ [(l, rng)]) EmptyRange lin lins recs
-complete _ _ = []
-
--- scanning
---scan :: (Ord c, Ord n, Ord l, Ord t) => AChart c n l t -> Item c n l t -> [Item c n l t]
-scan inp _ (Active rule found rng (Lin l (Tok tok:syms)) lins recs) =
- do rng' <- map makeRange (inputToken inp ? tok)
- rng'' <- concatRange rng rng'
- return $ Active rule found rng'' (Lin l syms) lins recs
-scan _ _ _ = []
-
--- | Creates an Active Item every time it is possible to combine
--- an Active Item from the agenda with a Passive Item from the Chart
-combine :: (Ord c, Ord n, Ord l, Ord t) => AChart c n l t -> Item c n l t -> [Item c n l t]
-combine chart item@(Active _ _ _ (Lin _ (Cat (c,_,_):_)) _ _) =
- do Passive _c found <- chartLookup chart (Pass c)
- combine2 chart found item
-combine chart (Passive c found) =
- do item <- chartLookup chart (Act c)
- combine2 chart found item
-combine _ _ = []
-
-combine2 chart found' (Active rule found rng (Lin l (Cat (c, r, d):syms)) lins recs) =
- do rng' <- projection r found'
- rng'' <- concatRange rng rng'
- recs' <- unifyRec recs d found'
- return $ Active rule found rng'' (Lin l syms) lins recs'
-
--- | Active Items with nothing to find are converted to Final items,
--- which in turn are converted to Passive Items
-convert :: (Ord c, Ord n, Ord l, Ord t) => AChart c n l t -> Item c n l t -> [Item c n l t]
-convert _ (Active rule found rng (Lin lbl []) [] recs) =
- return $ Final rule (found ++ [(lbl,rng)]) recs
-convert _ (Final (Abs cat _ _) found _) =
- return $ Passive cat found
-convert _ _ = []
-
-
-----------------------------------------------------------------------
--- Naive --
-
-predict :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l t]
-predict pinfo toks = tracePrt "MCFG.Active (Naive) - predicted rules" (prt . length) $
- do Rule abs (Cnc _ _ (lin:lins)) <- rulesMatchingInput pinfo toks
- return $ Active abs [] EmptyRange lin lins (emptyChildren abs)
-
-
-----------------------------------------------------------------------
--- Earley --
-
--- anropas med alla startkategorier
-initial :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> [c] -> Input t -> [Item c n l t]
-initial pinfo starts toks =
- tracePrt "MCFG.Active (Earley) - initial rules" (prt . length) $
- do cat <- starts
- Rule abs (Cnc _ _ (lin:lins)) <- topdownRules pinfo ? cat
- return $ Active abs [] (Range (0, 0)) lin lins (emptyChildren abs)
-
-predictEarley :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t
- -> AChart c n l t -> Item c n l t -> [Item c n l t]
-predictEarley pinfo toks _ item@(Active (Abs _ _ f) _ rng (Lin _ (Cat (cat,_,_):_)) _ _) =
- topdownRules pinfo ? cat >>= predictEarley2 toks rng
-predictEarley _ _ _ _ = []
-
-predictEarley2 :: (Ord c, Ord n, Ord l, Ord t) => Input t -> Range -> MCFRule c n l t -> [Item c n l t]
-predictEarley2 toks _ (Rule abs@(Abs _ [] _) (Cnc _ _ lins)) =
- do lins' <- rangeRestRec toks lins
- return $ Final abs (makeRangeRec lins') []
-predictEarley2 toks rng (Rule abs (Cnc _ _ (lin:lins))) =
- return $ Active abs [] EmptyRange lin lins (emptyChildren abs)
-
-
-----------------------------------------------------------------------
--- Kilbury --
-
-terminal :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l t]
-terminal pinfo toks =
- tracePrt "MCFG.Active (Kilbury) - initial terminal rules" (prt . length) $
- do Rule abs (Cnc _ _ lins) <- emptyRules pinfo
- lins' <- rangeRestRec toks lins
- return $ Final abs (makeRangeRec lins') []
-
-initialScan :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l t]
-initialScan pinfo toks =
- tracePrt "MCFG.Active (Kilbury) - initial scanned rules" (prt . length) $
- do tok <- aElems (inputToken toks)
- Rule abs (Cnc _ _ (lin:lins)) <- leftcornerTokens pinfo ? tok
- return $ Active abs [] EmptyRange lin lins (emptyChildren abs)
-
-predictKilbury :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t
- -> AChart c n l t -> Item c n l t -> [Item c n l t]
-predictKilbury pinfo toks _ (Passive cat found) =
- do Rule abs (Cnc _ _ (Lin l (Cat (_,r,i):syms) : lins)) <- leftcornerCats pinfo ? cat
- rng <- projection r found
- children <- unifyRec (emptyChildren abs) i found
- return $ Active abs [] rng (Lin l syms) lins children
-predictKilbury _ _ _ _ = []
-
-
-----------------------------------------------------------------------
--- * type definitions
-
-type AChart c n l t = ParseChart (Item c n l t) (AKey c t)
-
-data Item c n l t = Active (Abstract c n)
- (RangeRec l)
- Range
- (Lin c l t)
- (LinRec c l t)
- [RangeRec l]
- | Final (Abstract c n) (RangeRec l) [RangeRec l]
- | Passive c (RangeRec l)
- deriving (Eq, Ord, Show)
-
-data AKey c t = Act c
- | ActTok t
- | Pass c
- | Useless
- | Fin
- deriving (Eq, Ord, Show)
-
-
-keyof :: Item c n l t -> AKey c t
-keyof (Active _ _ _ (Lin _ (Cat (next, _, _):_)) _ _) = Act next
-keyof (Active _ _ _ (Lin _ (Tok tok:_)) _ _) = ActTok tok
-keyof (Final _ _ _) = Fin
-keyof (Passive cat _) = Pass cat
-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 ]) ++
- ", active-tok=" ++ show (sum [length (chartLookup chart k) |
- k@(ActTok _) <- chartKeys chart ]) ++
- ", useless=" ++ show (length (chartLookup chart Useless))
-
-prtChart chart = concat [ "\n*** KEY: " ++ prt k ++
- prtBefore "\n " (chartLookup chart k) |
- k <- chartKeys chart ]
-
-prtFinals chart = prtBefore "\n " (chartLookup chart Fin)
-
-instance (Print c, Print n, Print l, Print t) => Print (Item c n l t) 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 t) => Print (AKey c t) where
- prt (Act c) = "Active " ++ prt c
- prt (ActTok t) = "Active-Tok " ++ prt t
- prt (Pass c) = "Passive " ++ prt c
- prt (Fin) = "Final"
- prt (Useless) = "Useless"