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
|
----------------------------------------------------------------------
-- |
-- Maintainer : PL
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/08/08 09:01:25 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.3 $
--
-- MCFG parsing, the incremental algorithm (alternative version)
-----------------------------------------------------------------------------
module GF.Parsing.MCFG.Incremental2 (parse) where
import Data.List
import Data.Array
import Control.Monad (guard)
import GF.Data.Utilities (select)
import GF.Data.Assoc
import GF.Data.IncrementalDeduction
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
-- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
parse pinfo starts inp =
accumAssoc groupSyntaxNodes $
[ ((cat, found), SNode fun (zip rhs rrecs)) |
k <- uncurry enumFromTo (inputBounds inp),
Final (Abs cat rhs fun) found rrecs <- chartLookup chart k Fin ]
where chart = process pinfo inp
--process :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> (Int, Int) -> IChart c n l
process pinfo inp
= tracePrt "MCFG.Incremental - chart size"
(prt . map (prtSizes finalChart . fst) . assocs) $
finalChart
where finalChart = buildChart keyof rules axioms inBounds
axioms k = tracePrt ("MCFG.Incremental - axioms for " ++ show k) (prt . length) $
predict k ++ scan k ++ complete1 k
rules k item = complete2 k item ++ combine k item ++ convert k item
inBounds = inputBounds inp
-- axioms: predict + scan + complete
predict k = do Rule abs@(Abs _ rhs _) (Cnc _ _ lins) <- rulesMatchingInput pinfo inp
let daughters = replicate (length rhs) []
(lin, lins') <- select lins
return $ Active abs [] k lin lins' daughters
scan k = do (tok, js) <- aAssocs (inputTo inp ! k)
j <- js
Active abs found i (Lin l (Tok _tok:syms)) lins recs <-
chartLookup finalChart j (ActTok tok)
return $ Active abs found i (Lin l syms) lins recs
complete1 k = do j <- [fst inBounds .. k-1]
Active abs found i (Lin l _Nil) lins recs <-
chartLookup finalChart j Pass
let found' = found ++ [(l, makeRange (i,j))]
(lin, lins') <- select lins
return $ Active abs found' k lin lins' recs
-- rules: convert + combine + complete
convert k (Active rule found j (Lin lbl []) [] recs) =
let found' = found ++ [(lbl, makeRange (j,k))]
in return $ Final rule found' recs
convert _ _ = []
combine k (Active (Abs cat _ _) found' j (Lin lbl []) _ _) =
do guard (j < k) ---- cannot handle epsilon-rules
Active abs found i (Lin l (Cat (_cat,_lbl,nr):syms)) lins recs <-
chartLookup finalChart j (Act cat lbl)
let found'' = found' ++ [(lbl, makeRange (j,k))]
recs' <- unifyRec recs nr found''
return $ Active abs found i (Lin l syms) lins recs'
combine _ _ = []
complete2 k (Active abs found i (Lin l []) lins recs) =
do let found' = found ++ [(l, makeRange (i,k))]
(lin, lins') <- select lins
return $ Active abs found' k lin lins' recs
complete2 _ _ = []
----------------------------------------------------------------------
-- type definitions
type IChart c n l t = IncrementalChart (Item c n l t) (IKey c l t)
data Item c n l t = Active (Abstract c n)
(RangeRec l)
Int
(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 IKey c l t = Act c l
| ActTok t
---- | Useless
| Pass
| Fin
deriving (Eq, Ord, Show)
keyof :: Item c n l t -> IKey c l t
keyof (Active _ _ _ (Lin _ (Cat (next,lbl,_):_)) _ _) = Act next lbl
keyof (Active _ _ _ (Lin _ (Tok tok:_)) _ _) = ActTok tok
keyof (Active _ _ _ (Lin _ []) _ _) = Pass
keyof (Final _ _ _) = Fin
-- keyof _ = Useless
----------------------------------------------------------------------
-- for tracing purposes
prtSizes chart k = "f=" ++ show (length (chartLookup chart k Fin)) ++
" p=" ++ show (length (chartLookup chart k Pass)) ++
" a=" ++ show (sum [length (chartLookup chart k key) |
key@(Act _ _) <- chartKeys chart k ]) ++
" t=" ++ show (sum [length (chartLookup chart k key) |
key@(ActTok _) <- chartKeys chart k ])
-- " u=" ++ show (length (chartLookup chart k Useless))
-- prtChart chart = concat [ "\n*** KEY: " ++ prt k ++
-- prtBefore "\n " (chartLookup chart k) |
-- k <- chartKeys chart ]
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 l, Print t) => Print (IKey c l t) where
prt (Act c l) = "Active " ++ prt c ++ " " ++ prt l
prt (ActTok t) = "ActiveTok " ++ prt t
-- prt (Pass c l i) = "Passive " ++ prt c ++ " " ++ prt l ++ " @ " ++ prt i
prt (Fin) = "Final"
-- prt (Useless) = "Useless"
|
