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
|
----------------------------------------------------------------------
-- |
-- Module : EBNF
-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/21 16:21:13 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.5 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
module GF.Grammar.EBNF (EBNF, ERule, ERHS(..), ebnf2cf) where
import GF.Data.Operations
import GF.Grammar.CFG
import PGF (mkCId)
type EBNF = [ERule]
type ERule = (ECat, ERHS)
type ECat = (String,[Int])
type ETok = String
data ERHS =
ETerm ETok
| ENonTerm ECat
| ESeq ERHS ERHS
| EAlt ERHS ERHS
| EStar ERHS
| EPlus ERHS
| EOpt ERHS
| EEmpty
type CFRHS = [ParamCFSymbol]
type CFJustRule = ((Cat,[Param]), CFRHS)
ebnf2cf :: EBNF -> [ParamCFRule]
ebnf2cf ebnf =
[Rule cat items (mkCFF i cat) | (i,(cat,items)) <- zip [0..] (normEBNF ebnf)]
where
mkCFF i (c,_) = CFObj (mkCId ("Mk" ++ c ++ "_" ++ show i)) []
normEBNF :: EBNF -> [CFJustRule]
normEBNF erules = let
erules1 = [normERule ([i],r) | (i,r) <- zip [0..] erules]
erules2 = erules1 ---refreshECats erules1 --- this seems to be just bad !
erules3 = concat (map pickERules erules2)
--erules4 = nubERules erules3
in [(mkCFCatE cat, map eitem2cfitem its) | (cat,itss) <- erules3, its <- itss]
{-
refreshECats :: [NormERule] -> [NormERule]
refreshECats rules = [recas [i] rule | (i,rule) <- zip [0..] rules] where
recas ii (cat,its) = (updECat ii cat, [recss ii 0 s | s <- its])
recss ii n [] = []
recss ii n (s:ss) = recit (ii ++ [n]) s : recss ii (n+1) ss
recit ii it = case it of
EINonTerm cat -> EINonTerm (updECat ii cat)
EIStar (cat,t) -> EIStar (updECat ii cat, [recss ii 0 s | s <- t])
EIPlus (cat,t) -> EIPlus (updECat ii cat, [recss ii 0 s | s <- t])
EIOpt (cat,t) -> EIOpt (updECat ii cat, [recss ii 0 s | s <- t])
_ -> it
-}
pickERules :: NormERule -> [NormERule]
pickERules rule@(cat,alts) = rule : concat (map pics (concat alts)) where
pics it = case it of
EIStar ru@(cat,t) -> mkEStarRules cat ++ pickERules ru
EIPlus ru@(cat,t) -> mkEPlusRules cat ++ pickERules ru
EIOpt ru@(cat,t) -> mkEOptRules cat ++ pickERules ru
_ -> []
mkEStarRules cat = [(cat', [[],[EINonTerm cat, EINonTerm cat']])]
where cat' = mkNewECat cat "Star"
mkEPlusRules cat = [(cat', [[EINonTerm cat],[EINonTerm cat, EINonTerm cat']])]
where cat' = mkNewECat cat "Plus"
mkEOptRules cat = [(cat', [[],[EINonTerm cat]])]
where cat' = mkNewECat cat "Opt"
{-
nubERules :: [NormERule] -> [NormERule]
nubERules rules = nub optim where
optim = map (substERules (map mkSubst replaces)) irreducibles
(replaces,irreducibles) = partition reducible rules
reducible (cat,[items]) = isNewCat cat && all isOldIt items
reducible _ = False
isNewCat (_,ints) = ints == []
isOldIt (EITerm _) = True
isOldIt (EINonTerm cat) = not (isNewCat cat)
isOldIt _ = False
mkSubst (cat,its) = (cat, head its) -- def of reducible: its must be singleton
--- the optimization assumes each cat has at most one EBNF rule.
substERules :: [(ECat,[EItem])] -> NormERule -> NormERule
substERules g (cat,itss) = (cat, map sub itss) where
sub [] = []
sub (i@(EINonTerm cat') : ii) = case lookup cat g of
Just its -> its ++ sub ii
_ -> i : sub ii
sub (EIStar r : ii) = EIStar (substERules g r) : ii
sub (EIPlus r : ii) = EIPlus (substERules g r) : ii
sub (EIOpt r : ii) = EIOpt (substERules g r) : ii
-}
eitem2cfitem :: EItem -> ParamCFSymbol
eitem2cfitem it = case it of
EITerm a -> Terminal a
EINonTerm cat -> NonTerminal (mkCFCatE cat)
EIStar (cat,_) -> NonTerminal (mkCFCatE (mkNewECat cat "Star"))
EIPlus (cat,_) -> NonTerminal (mkCFCatE (mkNewECat cat "Plus"))
EIOpt (cat,_) -> NonTerminal (mkCFCatE (mkNewECat cat "Opt"))
type NormERule = (ECat,[[EItem]]) -- disjunction of sequences of items
data EItem =
EITerm String
| EINonTerm ECat
| EIStar NormERule
| EIPlus NormERule
| EIOpt NormERule
deriving Eq
normERule :: ([Int],ERule) -> NormERule
normERule (ii,(cat,rhs)) =
(cat,[map (mkEItem (ii ++ [i])) r' | (i,r') <- zip [0..] (disjNorm rhs)]) where
disjNorm r = case r of
ESeq r1 r2 -> [x ++ y | x <- disjNorm r1, y <- disjNorm r2]
EAlt r1 r2 -> disjNorm r1 ++ disjNorm r2
EEmpty -> [[]]
_ -> [[r]]
mkEItem :: [Int] -> ERHS -> EItem
mkEItem ii rhs = case rhs of
ETerm a -> EITerm a
ENonTerm cat -> EINonTerm cat
EStar r -> EIStar (normERule (ii,(mkECat ii, r)))
EPlus r -> EIPlus (normERule (ii,(mkECat ii, r)))
EOpt r -> EIOpt (normERule (ii,(mkECat ii, r)))
_ -> EINonTerm ("?????",[])
-- _ -> error "should not happen in ebnf" ---
mkECat ints = ("C", ints)
prECat (c,[]) = c
prECat (c,ints) = c ++ "_" ++ prTList "_" (map show ints)
mkCFCatE :: ECat -> (Cat,[Param])
mkCFCatE c = (prECat c,[0])
{-
updECat _ (c,[]) = (c,[])
updECat ii (c,_) = (c,ii)
-}
mkNewECat (c,ii) str = (c ++ str,ii)
|
