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
|
----------------------------------------------------------------------
-- |
-- 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"
|
