1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
----------------------------------------------------------------------
-- |
-- Maintainer : PL
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/08/08 09:01:25 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.4 $
--
-- MCFG parsing, the incremental algorithm
-----------------------------------------------------------------------------
module GF.Parsing.MCFG.Incremental (parse, parseR) where
import Data.List
import Control.Monad (guard)
import GF.Data.Utilities (select)
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 GF.Infra.Print
----------------------------------------------------------------------
-- parsing
parse :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
parse 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 pinfo toks ntoks
ntoks = snd (inputBounds toks)
-- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
parseR pinfo starts ntoks =
accumAssoc groupSyntaxNodes $
[ ((cat, found), SNode fun (zip rhs rrecs)) |
Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
where chart = processR pinfo ntoks
process :: (Ord n, Ord c, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> Int -> IChart c n l
process pinfo toks ntoks
= tracePrt "MCFG.Incremental - chart size" prtSizes $
buildChart keyof [complete ntoks, scan, combine, convert] (predict pinfo toks ntoks)
processR :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> Int -> IChart c n l
processR pinfo ntoks
= tracePrt "MCFG.Incremental Range - chart size" prtSizes $
buildChart keyof [complete ntoks, scan, combine, convert] (predictR pinfo ntoks)
complete :: (Ord n, Ord c, Ord l) => Int -> IChart c n l -> Item c n l -> [Item c n l]
complete ntoks _ (Active rule found rng (Lin l []) lins recs) =
do (lin, lins') <- select lins
k <- [minRange rng .. ntoks]
return $ Active rule (found ++ [(l, rng)]) (Range (k,k)) lin lins' recs
complete _ _ _ = []
predict :: (Ord n, Ord c, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> Int -> [Item c n l]
predict pinfo toks n =
tracePrt "MCFG.Incremental - predicted rules" (prt . length) $
do Rule abs@(Abs _ rhs _) (Cnc _ _ lins) <- rulesMatchingInput pinfo toks
let daughters = replicate (length rhs) []
lins' <- rangeRestRec toks lins
(lin', lins'') <- select lins'
k <- [0..n]
return $ Active abs [] (Range (k,k)) lin' lins'' daughters
predictR :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> Int -> [Item c n l]
predictR pinfo n =
tracePrt "MCFG.Incremental Range - predicted rules" (prt . length) $
do Rule abs@(Abs _ rhs _) (Cnc _ _ lins) <- allRules pinfo
let daughters = replicate (length rhs) []
(lin, lins') <- select lins
k <- [0..n]
return $ Active abs [] (Range (k,k)) lin lins' daughters
scan :: (Ord n, Ord c, Ord l) => IChart c n l -> Item c n l -> [Item c n l]
scan _ (Active abs found rng (Lin l (Tok rng':syms)) lins recs) =
do rng'' <- concatRange rng rng'
return $ Active abs found rng'' (Lin l syms) lins recs
scan _ _ = []
combine :: (Ord n, Ord c, Ord l) => IChart c n l -> Item c n l -> [Item c n l]
combine chart active@(Active _ _ rng (Lin _ (Cat (c,l,_):_)) _ _) =
do passive <- chartLookup chart (Pass c l (maxRange rng))
combine2 active passive
combine chart passive@(Active (Abs c _ _) _ rng (Lin l []) _ _) =
do active <- chartLookup chart (Act c l (minRange rng))
combine2 active passive
combine _ _ = []
combine2 (Active abs found rng (Lin l (Cat (c,l',d):syms)) lins recs)
(Active _ found' rng' _ _ _)
= do rng'' <- concatRange rng rng'
recs' <- unifyRec recs d found''
return $ Active abs found rng'' (Lin l syms) lins recs'
where found'' = found' ++ [(l',rng')]
convert _ (Active rule found rng (Lin lbl []) [] recs) =
return $ Final rule (found ++ [(lbl,rng)]) recs
convert _ _ = []
----------------------------------------------------------------------
-- type definitions
type IChart c n l = ParseChart (Item c n l) (IKey c l)
data Item c n l = Active (Abstract c n)
(RangeRec l)
Range
(Lin c l Range)
(LinRec c l Range)
[RangeRec l]
| Final (Abstract c n) (RangeRec l) [RangeRec l]
-- | Passive c (RangeRec l)
deriving (Eq, Ord, Show)
data IKey c l = Act c l Int
| Pass c l Int
| Useless
| Fin
deriving (Eq, Ord, Show)
keyof :: Item c n l -> IKey c l
keyof (Active _ _ rng (Lin _ (Cat (next,lbl,_):_)) _ _)
= Act next lbl (maxRange rng)
keyof (Active (Abs cat _ _) found rng (Lin lbl []) _ _)
= Pass cat lbl (minRange rng)
keyof (Final _ _ _) = Fin
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 ]) ++
", useless=" ++ show (length (chartLookup chart Useless))
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 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 l) => Print (IKey c l) where
prt (Act c l i) = "Active " ++ prt c ++ " " ++ prt l ++ " @ " ++ prt i
prt (Pass c l i) = "Passive " ++ prt c ++ " " ++ prt l ++ " @ " ++ prt i
prt (Fin) = "Final"
prt (Useless) = "Useless"
|
