mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-06 09:42:50 -06:00
124 lines
4.3 KiB
Haskell
124 lines
4.3 KiB
Haskell
{-- Module --------------------------------------------------------------------
|
|
Filename: IncrementalParse.hs
|
|
Author: Håkan Burden
|
|
Time-stamp: <2005-04-18, 15:07>
|
|
|
|
Description: An agenda-driven implementation of the incremental algorithm 4.6
|
|
that handles erasing and suppressing MCFG.
|
|
As described in Ljunglöf (2004)
|
|
------------------------------------------------------------------------------}
|
|
|
|
module IncrementalParse where
|
|
|
|
|
|
-- Haskell
|
|
import List
|
|
|
|
-- GF modules
|
|
import Examples
|
|
import GeneralChart
|
|
import MCFGrammar
|
|
import MCFParser
|
|
import Parser
|
|
import Range
|
|
import Nondet
|
|
|
|
|
|
{-- Datatypes -----------------------------------------------------------------
|
|
IChart: A RedBlackMap with Items and Keys
|
|
Item : One kind of Item since the Passive Items not necessarily need to be
|
|
saturated iow, they can still have rows to recognize.
|
|
IKey :
|
|
------------------------------------------------------------------------------}
|
|
|
|
type IChart n c l = ParseChart (Item n c l) (IKey c l)
|
|
|
|
data Item n c l = Active (AbstractRule n c)
|
|
(RangeRec l)
|
|
Range
|
|
(Lin c l Range)
|
|
(LinRec c l Range)
|
|
[RangeRec l]
|
|
-- | Passive (AbstractRule n c)
|
|
-- (RangeRec l)
|
|
-- [RangeRec l]
|
|
deriving (Eq, Ord, Show)
|
|
|
|
data IKey c l = Act c l Int
|
|
-- | ActE l
|
|
| Pass c l Int
|
|
-- | Pred l
|
|
| Useless
|
|
deriving (Eq, Ord, Show)
|
|
|
|
keyof :: Item n c l -> IKey c l
|
|
keyof (Active _ _ (Range (_,j)) (Lin _ ((Cat (next,lbl,_)):_)) _ _)
|
|
= Act next lbl j
|
|
keyof (Active (_, cat, _) found (Range (i,_)) (Lin lbl []) _ _)
|
|
= Pass cat lbl i
|
|
keyof _
|
|
= Useless
|
|
|
|
|
|
{-- Parsing -------------------------------------------------------------------
|
|
recognize:
|
|
parse : Builds a chart from the initial agenda, given by prediction, and
|
|
the inference rules
|
|
keyof : Given an Item returns an appropriate Key for the Chart
|
|
------------------------------------------------------------------------------}
|
|
|
|
recognize mcfg toks = chartMember (parse mcfg toks) item (keyof item)
|
|
where n = length toks
|
|
n2 = n `div` 2
|
|
item = Active ("f",S,[A])
|
|
[] (Range (0, n)) (Lin "s" []) []
|
|
[[("p", Range (0, n2)), ("q", Range (n2, n))]]
|
|
|
|
|
|
parse :: (Ord n, Ord c, Ord l, Eq t) => Grammar n c l t -> [t] -> IChart n c l
|
|
parse mcfg toks = buildChart keyof [complete ntoks, scan, combine] (predict mcfg toks ntoks)
|
|
where ntoks = length toks
|
|
|
|
complete :: (Ord n, Ord c, Ord l) => Int -> IChart n c l
|
|
-> Item n c l -> [Item n c l]
|
|
complete ntoks _ (Active rule found rng@(Range (_,j)) (Lin l []) lins recs) =
|
|
[ Active rule (found ++ [(l, rng)]) (Range (k,k)) lin lins' recs |
|
|
(lin, lins') <- select lins,
|
|
k <- [j .. ntoks] ]
|
|
complete _ _ _ = []
|
|
|
|
|
|
predict :: (Eq n, Eq c, Eq l, Eq t) => Grammar n c l t -> [t] -> Int -> [Item n c l]
|
|
predict mcfg toks n = [ Active (f, c, rhs) [] (Range (k,k)) lin' lins'' daughters |
|
|
Rule c rhs lins f <- mcfg,
|
|
let daughters = replicate (length rhs) [],
|
|
lins' <- solutions $ rangeRestRec toks lins,
|
|
(lin', lins'') <- select lins',
|
|
k <- [0..n] ]
|
|
|
|
|
|
scan :: (Ord n, Ord c, Ord l) => IChart n c l -> Item n c l -> [Item n c l]
|
|
scan _ (Active rule found rng (Lin l (Tok rng':syms)) lins recs) =
|
|
[ Active rule found rng'' (Lin l syms) lins recs |
|
|
rng'' <- solutions $ concRanges rng rng' ]
|
|
scan _ _ = []
|
|
|
|
|
|
combine :: (Ord n, Ord c, Ord l) => IChart n c l -> Item n c l -> [Item n c l]
|
|
combine chart (Active rule found rng@(Range (_,j)) (Lin l ((Cat (c,r,d)):syms)) lins recs) =
|
|
[ Active rule found rng'' (Lin l syms) lins (replaceRec recs d (found' ++ [(l',rng')])) |
|
|
Active _ found' rng' (Lin l' []) _ _ <- chartLookup chart (Pass c r j),
|
|
subsumes (recs !! d) (found' ++ [(l',rng')]),
|
|
rng'' <- solutions $ concRanges rng rng' ]
|
|
combine chart (Active (_,c,_) found rng'@(Range (i,_)) (Lin l []) _ _) =
|
|
[ Active rule found' rng'' (Lin l' syms) lins (replaceRec recs d (found ++ [(l,rng')])) |
|
|
Active rule found' rng (Lin l' ((Cat (c,r,d)):syms)) lins recs
|
|
<- chartLookup chart (Act c l i),
|
|
subsumes (recs !! d) (found ++ [(l,rng')]),
|
|
rng'' <- solutions $ concRanges rng rng' ]
|
|
combine _ _ = []
|
|
|
|
|
|
|
|
|