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 -> [ParamCFRule]
ebnf2cf EBNF
ebnf =
[(Cat, [Param])
-> [Symbol (Cat, [Param]) Cat] -> CFTerm -> ParamCFRule
forall c t. c -> [Symbol c t] -> CFTerm -> Rule c t
Rule (Cat, [Param])
cat [Symbol (Cat, [Param]) Cat]
items (Integer -> (Cat, [Param]) -> CFTerm
forall a b. Show a => a -> (Cat, b) -> CFTerm
mkCFF Integer
i (Cat, [Param])
cat) | (Integer
i,((Cat, [Param])
cat,[Symbol (Cat, [Param]) Cat]
items)) <- [Integer] -> [CFJustRule] -> [(Integer, CFJustRule)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] (EBNF -> [CFJustRule]
normEBNF EBNF
ebnf)]
where
mkCFF :: a -> (Cat, b) -> CFTerm
mkCFF a
i (Cat
c,b
_) = CId -> [CFTerm] -> CFTerm
CFObj (Cat -> CId
mkCId (Cat
"Mk" Cat -> Cat -> Cat
forall a. [a] -> [a] -> [a]
++ Cat
c Cat -> Cat -> Cat
forall a. [a] -> [a] -> [a]
++ Cat
"_" Cat -> Cat -> Cat
forall a. [a] -> [a] -> [a]
++ a -> Cat
forall a. Show a => a -> Cat
show a
i)) []
normEBNF :: EBNF -> [CFJustRule]
normEBNF :: EBNF -> [CFJustRule]
normEBNF EBNF
erules = let
erules1 :: [NormERule]
erules1 = [([Param], ERule) -> NormERule
normERule ([Param
i],ERule
r) | (Param
i,ERule
r) <- [Param] -> EBNF -> [(Param, ERule)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Param
0..] EBNF
erules]
erules2 :: [NormERule]
erules2 = [NormERule]
erules1
erules3 :: [NormERule]
erules3 = [[NormERule]] -> [NormERule]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((NormERule -> [NormERule]) -> [NormERule] -> [[NormERule]]
forall a b. (a -> b) -> [a] -> [b]
map NormERule -> [NormERule]
pickERules [NormERule]
erules2)
in [((Cat, [Param]) -> (Cat, [Param])
mkCFCatE (Cat, [Param])
cat, (EItem -> Symbol (Cat, [Param]) Cat)
-> [EItem] -> [Symbol (Cat, [Param]) Cat]
forall a b. (a -> b) -> [a] -> [b]
map EItem -> Symbol (Cat, [Param]) Cat
eitem2cfitem [EItem]
its) | ((Cat, [Param])
cat,[[EItem]]
itss) <- [NormERule]
erules3, [EItem]
its <- [[EItem]]
itss]
pickERules :: NormERule -> [NormERule]
pickERules :: NormERule -> [NormERule]
pickERules rule :: NormERule
rule@((Cat, [Param])
cat,[[EItem]]
alts) = NormERule
rule NormERule -> [NormERule] -> [NormERule]
forall a. a -> [a] -> [a]
: [[NormERule]] -> [NormERule]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((EItem -> [NormERule]) -> [EItem] -> [[NormERule]]
forall a b. (a -> b) -> [a] -> [b]
map EItem -> [NormERule]
pics ([[EItem]] -> [EItem]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[EItem]]
alts)) where
pics :: EItem -> [NormERule]
pics EItem
it = case EItem
it of
EIStar ru :: NormERule
ru@((Cat, [Param])
cat,[[EItem]]
t) -> (Cat, [Param]) -> [NormERule]
mkEStarRules (Cat, [Param])
cat [NormERule] -> [NormERule] -> [NormERule]
forall a. [a] -> [a] -> [a]
++ NormERule -> [NormERule]
pickERules NormERule
ru
EIPlus ru :: NormERule
ru@((Cat, [Param])
cat,[[EItem]]
t) -> (Cat, [Param]) -> [NormERule]
mkEPlusRules (Cat, [Param])
cat [NormERule] -> [NormERule] -> [NormERule]
forall a. [a] -> [a] -> [a]
++ NormERule -> [NormERule]
pickERules NormERule
ru
EIOpt ru :: NormERule
ru@((Cat, [Param])
cat,[[EItem]]
t) -> (Cat, [Param]) -> [NormERule]
mkEOptRules (Cat, [Param])
cat [NormERule] -> [NormERule] -> [NormERule]
forall a. [a] -> [a] -> [a]
++ NormERule -> [NormERule]
pickERules NormERule
ru
EItem
_ -> []
mkEStarRules :: (Cat, [Param]) -> [NormERule]
mkEStarRules (Cat, [Param])
cat = [((Cat, [Param])
cat', [[],[(Cat, [Param]) -> EItem
EINonTerm (Cat, [Param])
cat, (Cat, [Param]) -> EItem
EINonTerm (Cat, [Param])
cat']])]
where cat' :: (Cat, [Param])
cat' = (Cat, [Param]) -> Cat -> (Cat, [Param])
forall a b. ([a], b) -> [a] -> ([a], b)
mkNewECat (Cat, [Param])
cat Cat
"Star"
mkEPlusRules :: (Cat, [Param]) -> [NormERule]
mkEPlusRules (Cat, [Param])
cat = [((Cat, [Param])
cat', [[(Cat, [Param]) -> EItem
EINonTerm (Cat, [Param])
cat],[(Cat, [Param]) -> EItem
EINonTerm (Cat, [Param])
cat, (Cat, [Param]) -> EItem
EINonTerm (Cat, [Param])
cat']])]
where cat' :: (Cat, [Param])
cat' = (Cat, [Param]) -> Cat -> (Cat, [Param])
forall a b. ([a], b) -> [a] -> ([a], b)
mkNewECat (Cat, [Param])
cat Cat
"Plus"
mkEOptRules :: (Cat, [Param]) -> [NormERule]
mkEOptRules (Cat, [Param])
cat = [((Cat, [Param])
cat', [[],[(Cat, [Param]) -> EItem
EINonTerm (Cat, [Param])
cat]])]
where cat' :: (Cat, [Param])
cat' = (Cat, [Param]) -> Cat -> (Cat, [Param])
forall a b. ([a], b) -> [a] -> ([a], b)
mkNewECat (Cat, [Param])
cat Cat
"Opt"
eitem2cfitem :: EItem -> ParamCFSymbol
eitem2cfitem :: EItem -> Symbol (Cat, [Param]) Cat
eitem2cfitem EItem
it = case EItem
it of
EITerm Cat
a -> Cat -> Symbol (Cat, [Param]) Cat
forall c t. t -> Symbol c t
Terminal Cat
a
EINonTerm (Cat, [Param])
cat -> (Cat, [Param]) -> Symbol (Cat, [Param]) Cat
forall c t. c -> Symbol c t
NonTerminal ((Cat, [Param]) -> (Cat, [Param])
mkCFCatE (Cat, [Param])
cat)
EIStar ((Cat, [Param])
cat,[[EItem]]
_) -> (Cat, [Param]) -> Symbol (Cat, [Param]) Cat
forall c t. c -> Symbol c t
NonTerminal ((Cat, [Param]) -> (Cat, [Param])
mkCFCatE ((Cat, [Param]) -> Cat -> (Cat, [Param])
forall a b. ([a], b) -> [a] -> ([a], b)
mkNewECat (Cat, [Param])
cat Cat
"Star"))
EIPlus ((Cat, [Param])
cat,[[EItem]]
_) -> (Cat, [Param]) -> Symbol (Cat, [Param]) Cat
forall c t. c -> Symbol c t
NonTerminal ((Cat, [Param]) -> (Cat, [Param])
mkCFCatE ((Cat, [Param]) -> Cat -> (Cat, [Param])
forall a b. ([a], b) -> [a] -> ([a], b)
mkNewECat (Cat, [Param])
cat Cat
"Plus"))
EIOpt ((Cat, [Param])
cat,[[EItem]]
_) -> (Cat, [Param]) -> Symbol (Cat, [Param]) Cat
forall c t. c -> Symbol c t
NonTerminal ((Cat, [Param]) -> (Cat, [Param])
mkCFCatE ((Cat, [Param]) -> Cat -> (Cat, [Param])
forall a b. ([a], b) -> [a] -> ([a], b)
mkNewECat (Cat, [Param])
cat Cat
"Opt"))
type NormERule = (ECat,[[EItem]])
data EItem =
EITerm String
| EINonTerm ECat
| EIStar NormERule
| EIPlus NormERule
| EIOpt NormERule
deriving EItem -> EItem -> Bool
(EItem -> EItem -> Bool) -> (EItem -> EItem -> Bool) -> Eq EItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EItem -> EItem -> Bool
$c/= :: EItem -> EItem -> Bool
== :: EItem -> EItem -> Bool
$c== :: EItem -> EItem -> Bool
Eq
normERule :: ([Int],ERule) -> NormERule
normERule :: ([Param], ERule) -> NormERule
normERule ([Param]
ii,((Cat, [Param])
cat,ERHS
rhs)) =
((Cat, [Param])
cat,[(ERHS -> EItem) -> [ERHS] -> [EItem]
forall a b. (a -> b) -> [a] -> [b]
map ([Param] -> ERHS -> EItem
mkEItem ([Param]
ii [Param] -> [Param] -> [Param]
forall a. [a] -> [a] -> [a]
++ [Param
i])) [ERHS]
r' | (Param
i,[ERHS]
r') <- [Param] -> [[ERHS]] -> [(Param, [ERHS])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Param
0..] (ERHS -> [[ERHS]]
disjNorm ERHS
rhs)]) where
disjNorm :: ERHS -> [[ERHS]]
disjNorm ERHS
r = case ERHS
r of
ESeq ERHS
r1 ERHS
r2 -> [[ERHS]
x [ERHS] -> [ERHS] -> [ERHS]
forall a. [a] -> [a] -> [a]
++ [ERHS]
y | [ERHS]
x <- ERHS -> [[ERHS]]
disjNorm ERHS
r1, [ERHS]
y <- ERHS -> [[ERHS]]
disjNorm ERHS
r2]
EAlt ERHS
r1 ERHS
r2 -> ERHS -> [[ERHS]]
disjNorm ERHS
r1 [[ERHS]] -> [[ERHS]] -> [[ERHS]]
forall a. [a] -> [a] -> [a]
++ ERHS -> [[ERHS]]
disjNorm ERHS
r2
ERHS
EEmpty -> [[]]
ERHS
_ -> [[ERHS
r]]
mkEItem :: [Int] -> ERHS -> EItem
mkEItem :: [Param] -> ERHS -> EItem
mkEItem [Param]
ii ERHS
rhs = case ERHS
rhs of
ETerm Cat
a -> Cat -> EItem
EITerm Cat
a
ENonTerm (Cat, [Param])
cat -> (Cat, [Param]) -> EItem
EINonTerm (Cat, [Param])
cat
EStar ERHS
r -> NormERule -> EItem
EIStar (([Param], ERule) -> NormERule
normERule ([Param]
ii,([Param] -> (Cat, [Param])
forall b. b -> (Cat, b)
mkECat [Param]
ii, ERHS
r)))
EPlus ERHS
r -> NormERule -> EItem
EIPlus (([Param], ERule) -> NormERule
normERule ([Param]
ii,([Param] -> (Cat, [Param])
forall b. b -> (Cat, b)
mkECat [Param]
ii, ERHS
r)))
EOpt ERHS
r -> NormERule -> EItem
EIOpt (([Param], ERule) -> NormERule
normERule ([Param]
ii,([Param] -> (Cat, [Param])
forall b. b -> (Cat, b)
mkECat [Param]
ii, ERHS
r)))
ERHS
_ -> (Cat, [Param]) -> EItem
EINonTerm (Cat
"?????",[])
mkECat :: b -> (Cat, b)
mkECat b
ints = (Cat
"C", b
ints)
prECat :: (Cat, [a]) -> Cat
prECat (Cat
c,[]) = Cat
c
prECat (Cat
c,[a]
ints) = Cat
c Cat -> Cat -> Cat
forall a. [a] -> [a] -> [a]
++ Cat
"_" Cat -> Cat -> Cat
forall a. [a] -> [a] -> [a]
++ Cat -> [Cat] -> Cat
prTList Cat
"_" ((a -> Cat) -> [a] -> [Cat]
forall a b. (a -> b) -> [a] -> [b]
map a -> Cat
forall a. Show a => a -> Cat
show [a]
ints)
mkCFCatE :: ECat -> (Cat,[Param])
mkCFCatE :: (Cat, [Param]) -> (Cat, [Param])
mkCFCatE (Cat, [Param])
c = ((Cat, [Param]) -> Cat
forall a. Show a => (Cat, [a]) -> Cat
prECat (Cat, [Param])
c,[Param
0])
mkNewECat :: ([a], b) -> [a] -> ([a], b)
mkNewECat ([a]
c,b
ii) [a]
str = ([a]
c [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
str,b
ii)