diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
| commit | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch) | |
| tree | 0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/Parsing/MCFG/Active2.hs | |
| parent | fe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff) | |
removed src for 2.9
Diffstat (limited to 'src/GF/Parsing/MCFG/Active2.hs')
| -rw-r--r-- | src/GF/Parsing/MCFG/Active2.hs | 237 |
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" |
