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
|
---------------------------------------------------------------------
-- |
-- Maintainer : Krasimir Angelov
-- Stability : (stable)
-- Portability : (portable)
--
-- FCFG parsing, parser information
-----------------------------------------------------------------------------
module GF.Parsing.FCFG.PInfo where
import GF.System.Tracing
import GF.Infra.Print
import GF.Formalism.Utilities
import GF.Formalism.GCFG
import GF.Formalism.FCFG
import GF.Data.SortedList
import GF.Data.Assoc
import GF.Parsing.FCFG.Range
import Data.Array
import Data.Maybe
----------------------------------------------------------------------
-- type declarations
-- | the list of categories = possible starting categories
type FCFParser c n t = FCFPInfo c n t
-> [c]
-> Input t
-> SyntaxChart n (c,RangeRec)
makeFinalEdge cat 0 0 = (cat, [EmptyRange])
makeFinalEdge cat i j = (cat, [makeRange i j])
------------------------------------------------------------
-- parser information
type RuleId = Int
data FCFPInfo c n t
= FCFPInfo { allRules :: Array RuleId (FCFRule c n t)
, topdownRules :: Assoc c (SList RuleId)
-- ^ used in 'GF.Parsing.MCFG.Active' (Earley):
-- , emptyRules :: [RuleId]
, epsilonRules :: [RuleId]
-- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
, leftcornerCats :: Assoc c (SList RuleId)
, leftcornerTokens :: Assoc t (SList RuleId)
-- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
, grammarCats :: SList c
, grammarToks :: SList t
, grammarLexer :: t -> (c,SyntaxNode RuleId RangeRec)
}
getLeftCornerTok lins
| inRange (bounds syms) 0 = case syms ! 0 of
FSymTok tok -> Just tok
_ -> Nothing
| otherwise = Nothing
where
syms = lins ! 0
getLeftCornerCat lins
| inRange (bounds syms) 0 = case syms ! 0 of
FSymCat c _ _ -> Just c
_ -> Nothing
| otherwise = Nothing
where
syms = lins ! 0
buildFCFPInfo :: (Ord c, Ord n, Ord t) => (t -> (c,SyntaxNode RuleId RangeRec)) -> FCFGrammar c n t -> FCFPInfo c n t
buildFCFPInfo lexer grammar =
traceCalcFirst grammar $
tracePrt "MCFG.PInfo - parser info" (prt) $
FCFPInfo { allRules = allrules
, topdownRules = topdownrules
-- , emptyRules = emptyrules
, epsilonRules = epsilonrules
, leftcornerCats = leftcorncats
, leftcornerTokens = leftcorntoks
, grammarCats = grammarcats
, grammarToks = grammartoks
, grammarLexer = lexer
}
where allrules = listArray (0,length grammar-1) grammar
topdownrules = accumAssoc id [(cat, ruleid) | (ruleid, FRule (Abs cat _ _) _) <- assocs allrules]
-- emptyrules = [ruleid | (ruleid, FRule (Abs _ [] _) _) <- assocs allrules]
epsilonrules = [ ruleid | (ruleid, FRule _ lins) <- assocs allrules,
not (inRange (bounds (lins ! 0)) 0) ]
leftcorncats = accumAssoc id
[ (fromJust (getLeftCornerCat lins), ruleid) |
(ruleid, FRule _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ]
leftcorntoks = accumAssoc id
[ (fromJust (getLeftCornerTok lins), ruleid) |
(ruleid, FRule _ lins) <- assocs allrules, isJust (getLeftCornerTok lins) ]
grammarcats = aElems topdownrules
grammartoks = nubsort [t | (FRule _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]
----------------------------------------------------------------------
-- pretty-printing of statistics
instance (Ord c, Ord n, Ord t) => Print (FCFPInfo c n t) where
prt pI = "[ allRules=" ++ sl (elems . allRules) ++
"; tdRules=" ++ sla topdownRules ++
-- "; emptyRules=" ++ sl emptyRules ++
"; epsilonRules=" ++ sl epsilonRules ++
"; lcCats=" ++ sla leftcornerCats ++
"; lcTokens=" ++ sla leftcornerTokens ++
"; categories=" ++ sl grammarCats ++
" ]"
where sl f = show $ length $ f pI
sla f = let (as, bs) = unzip $ aAssocs $ f pI
in show (length as) ++ "/" ++ show (length (concat bs))
|
