----------------------------------------------------------------------
-- |
-- 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 -> [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 ---refreshECats erules1 --- this seems to be just bad !
  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)
--erules4 = nubERules erules3
 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]
{-
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 :: 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"
{-
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 :: 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]]) -- disjunction of sequences of items

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
"?????",[])
--  _ -> error "should not happen in ebnf" ---

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])
{-
updECat _ (c,[]) = (c,[])
updECat ii (c,_) = (c,ii)
-}
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)