diff options
Diffstat (limited to 'src-2.9/GF/Parsing/MCFG/Naive.hs')
| -rw-r--r-- | src-2.9/GF/Parsing/MCFG/Naive.hs | 142 |
1 files changed, 142 insertions, 0 deletions
diff --git a/src-2.9/GF/Parsing/MCFG/Naive.hs b/src-2.9/GF/Parsing/MCFG/Naive.hs new file mode 100644 index 000000000..7d1fa0a8a --- /dev/null +++ b/src-2.9/GF/Parsing/MCFG/Naive.hs @@ -0,0 +1,142 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : PL +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/08/08 09:01:25 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.5 $ +-- +-- MCFG parsing, the naive algorithm +----------------------------------------------------------------------------- + +module GF.Parsing.MCFG.Naive (parse, parseR) where + +import Control.Monad (guard) + +-- GF modules +import GF.Data.GeneralDeduction +import GF.Formalism.GCFG +import GF.Formalism.MCFG +import GF.Formalism.Utilities +import GF.Parsing.MCFG.Range +import GF.Parsing.MCFG.PInfo +import GF.Data.SortedList +import GF.Data.Assoc +import GF.System.Tracing + +import GF.Infra.Print + +---------------------------------------------------------------------- +-- * parsing + +-- | Builds a chart from the initial agenda, given by prediction, and the inference rules +parse :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t +parse pinfo starts toks + = accumAssoc groupSyntaxNodes $ + [ ((cat, makeRangeRec lins), SNode fun (zip rhs rrecs)) | + Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ] + where chart = process pinfo toks + +-- | Builds a chart from the initial agenda, given by prediction, and the inference rules +-- parseR :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t +parseR pinfo starts + = accumAssoc groupSyntaxNodes $ + [ ((cat, makeRangeRec lins), SNode fun (zip rhs rrecs)) | + Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ] + where chart = processR pinfo + +process :: (Ord t, Ord n, Ord c, Ord l) => MCFPInfo c n l t -> Input t -> NChart c n l +process pinfo toks + = tracePrt "MCFG.Naive - chart size" prtSizes $ + buildChart keyof [convert, combine] (predict pinfo toks) + +processR :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> NChart c n l +processR pinfo + = tracePrt "MCFG.Naive Range - chart size" prtSizes $ + buildChart keyof [convert, combine] (predictR pinfo) + + +---------------------------------------------------------------------- +-- * inference rules + +-- Creates an Active Item of every Rule in the Grammar to give the initial Agenda +predict :: (Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l] +predict pinfo toks = tracePrt "MCFG.Naive - predicted rules" (prt . length) $ + do Rule abs (Cnc _ _ lins) <- rulesMatchingInput pinfo toks + lins' <- rangeRestRec toks lins + return $ Active (abs, []) lins' [] + +-- Creates an Active Item of every Rule in the Grammar to give the initial Agenda +predictR :: (Ord l) => MCFPInfo c n l Range -> [Item c n l] +predictR pinfo = tracePrt "MCFG.Naive Range - predicted rules" (prt . length) $ + do Rule abs (Cnc _ _ lins) <- allRules pinfo + return $ Active (abs, []) lins [] + +-- | 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 n, Ord c, Ord l) => NChart c n l -> Item c n l -> [Item c n l] +combine chart item@(Active (Abs _ (c:_) _, _) _ _) = + do Passive _c rrec <- chartLookup chart (Pass c) + combine2 chart rrec item +combine chart (Passive c rrec) = + do item <- chartLookup chart (Act c) + combine2 chart rrec item +combine _ _ = [] + +combine2 chart rrec (Active (Abs nt (c:find) f, found) lins rrecs) = + do lins' <- substArgRec (length found) rrec lins + return $ Active (Abs nt find f, found ++ [c]) lins' (rrecs ++ [rrec]) + +-- | Active Items with nothing to find are converted to Passive Items +convert :: (Ord n, Ord c, Ord l) => NChart c n l -> Item c n l -> [Item c n l] +convert _ (Active (Abs cat [] fun, _) lins _) = [Passive cat (makeRangeRec lins)] +convert _ _ = [] + + +---------------------------------------------------------------------- +-- * type definitions + +type NChart c n l = ParseChart (Item c n l) (NKey c) + +data Item c n l = Active (DottedRule c n) (LinRec c l Range) [RangeRec l] + | Passive c (RangeRec l) + deriving (Eq, Ord, Show) + +type DottedRule c n = (Abstract c n, [c]) + +data NKey c = Act c + | Pass c + | Final + deriving (Eq, Ord, Show) + +keyof :: Item c n l -> NKey c +keyof (Active (Abs _ (next:_) _, _) _ _) = Act next +keyof (Passive cat _) = Pass cat +keyof _ = Final + +-- for tracing purposes +prtSizes chart = "final=" ++ show (length (chartLookup chart Final)) ++ + ", passive=" ++ show (sum [length (chartLookup chart k) | + k@(Pass _) <- chartKeys chart ]) ++ + ", active=" ++ show (sum [length (chartLookup chart k) | + k@(Act _) <- chartKeys chart ]) + +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, cs) lrec rrecs) = "? " ++ prt abs ++ " . " ++ prtSep " " cs ++ ";\n\t" ++ + "{" ++ prtSep " " lrec ++ "}" ++ + ( if null rrecs then ";" else ";\n\t" ++ + "{" ++ prtSep "} {" (map (prtSep " ") rrecs) ++ "}" ) + prt (Passive c rrec) = "- " ++ prt c ++ "; {" ++ prtSep " " rrec ++ "}" + +instance Print c => Print (NKey c) where + prt (Act c) = "Active " ++ prt c + prt (Pass c) = "Passive " ++ prt c + prt (Final) = "Final" + + |