forked from GitHub/gf-core
143 lines
5.3 KiB
Haskell
143 lines
5.3 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- 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"
|
|
|
|
|