module CFG where

import Data.List(nub,intersperse)

--------------------------------------------------------------------------------
-- Context Free Grammar
--------------------------------------------------------------------------------
data Symbol = Nonterminal String | Terminal String 
    deriving (Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq, ReadPrec [Symbol]
ReadPrec Symbol
Int -> ReadS Symbol
ReadS [Symbol]
(Int -> ReadS Symbol)
-> ReadS [Symbol]
-> ReadPrec Symbol
-> ReadPrec [Symbol]
-> Read Symbol
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Symbol]
$creadListPrec :: ReadPrec [Symbol]
readPrec :: ReadPrec Symbol
$creadPrec :: ReadPrec Symbol
readList :: ReadS [Symbol]
$creadList :: ReadS [Symbol]
readsPrec :: Int -> ReadS Symbol
$creadsPrec :: Int -> ReadS Symbol
Read)
             
instance Show Symbol where
  showsPrec :: Int -> Symbol -> ShowS
showsPrec Int
p (Nonterminal String
x) = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
x
  showsPrec Int
p (Terminal String
x)    = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
x
  
isTerminal :: Symbol -> Bool
isTerminal (Terminal String
x) = Bool
True  
isTerminal Symbol
_            = Bool
False
  
data ExtendedSymbol = Symbol Symbol | Epsilon | EndOfSymbol
    deriving ExtendedSymbol -> ExtendedSymbol -> Bool
(ExtendedSymbol -> ExtendedSymbol -> Bool)
-> (ExtendedSymbol -> ExtendedSymbol -> Bool) -> Eq ExtendedSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendedSymbol -> ExtendedSymbol -> Bool
$c/= :: ExtendedSymbol -> ExtendedSymbol -> Bool
== :: ExtendedSymbol -> ExtendedSymbol -> Bool
$c== :: ExtendedSymbol -> ExtendedSymbol -> Bool
Eq
             
instance Show ExtendedSymbol where
  showsPrec :: Int -> ExtendedSymbol -> ShowS
showsPrec Int
p (Symbol Symbol
sym)    = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (Symbol -> String
forall a. Show a => a -> String
show Symbol
sym)
  showsPrec Int
p (ExtendedSymbol
Epsilon)       = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
"epsilon"
  showsPrec Int
p (ExtendedSymbol
EndOfSymbol)   = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
"$"
  
isExtendedTerminal :: ExtendedSymbol -> Bool
isExtendedTerminal (Symbol (Terminal String
x)) = Bool
True  
isExtendedTerminal (ExtendedSymbol
EndOfSymbol)         = Bool
True  
isExtendedTerminal ExtendedSymbol
_                     = Bool
False

isExtendedNonterminal :: ExtendedSymbol -> Bool
isExtendedNonterminal (Symbol (Nonterminal String
x)) = Bool
True  
isExtendedNonterminal ExtendedSymbol
_                        = Bool
False

data ProductionRule = ProductionRule String [Symbol] 
         deriving (ProductionRule -> ProductionRule -> Bool
(ProductionRule -> ProductionRule -> Bool)
-> (ProductionRule -> ProductionRule -> Bool) -> Eq ProductionRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProductionRule -> ProductionRule -> Bool
$c/= :: ProductionRule -> ProductionRule -> Bool
== :: ProductionRule -> ProductionRule -> Bool
$c== :: ProductionRule -> ProductionRule -> Bool
Eq, ReadPrec [ProductionRule]
ReadPrec ProductionRule
Int -> ReadS ProductionRule
ReadS [ProductionRule]
(Int -> ReadS ProductionRule)
-> ReadS [ProductionRule]
-> ReadPrec ProductionRule
-> ReadPrec [ProductionRule]
-> Read ProductionRule
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProductionRule]
$creadListPrec :: ReadPrec [ProductionRule]
readPrec :: ReadPrec ProductionRule
$creadPrec :: ReadPrec ProductionRule
readList :: ReadS [ProductionRule]
$creadList :: ReadS [ProductionRule]
readsPrec :: Int -> ReadS ProductionRule
$creadsPrec :: Int -> ReadS ProductionRule
Read)
                  
instance Show ProductionRule where
  showsPrec :: Int -> ProductionRule -> ShowS
showsPrec Int
p (ProductionRule String
x [Symbol]
ys) = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ShowS
forall a. Show a => [a] -> ShowS
show_ys [Symbol]
ys
  
type ProductionRules = [ProductionRule]  
  
show_ys :: [a] -> ShowS
show_ys []     = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
""  
show_ys [a
y] = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (a -> String
forall a. Show a => a -> String
show a
y) 
show_ys (a
y:[a]
ys) = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (a -> String
forall a. Show a => a -> String
show a
y) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
show_ys [a]
ys

data CFG = CFG String [ProductionRule] 
         deriving (Int -> CFG -> ShowS
[CFG] -> ShowS
CFG -> String
(Int -> CFG -> ShowS)
-> (CFG -> String) -> ([CFG] -> ShowS) -> Show CFG
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFG] -> ShowS
$cshowList :: [CFG] -> ShowS
show :: CFG -> String
$cshow :: CFG -> String
showsPrec :: Int -> CFG -> ShowS
$cshowsPrec :: Int -> CFG -> ShowS
Show, ReadPrec [CFG]
ReadPrec CFG
Int -> ReadS CFG
ReadS [CFG]
(Int -> ReadS CFG)
-> ReadS [CFG] -> ReadPrec CFG -> ReadPrec [CFG] -> Read CFG
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CFG]
$creadListPrec :: ReadPrec [CFG]
readPrec :: ReadPrec CFG
$creadPrec :: ReadPrec CFG
readList :: ReadS [CFG]
$creadList :: ReadS [CFG]
readsPrec :: Int -> ReadS CFG
$creadsPrec :: Int -> ReadS CFG
Read)

type AUGCFG = CFG

startNonterminal :: CFG -> String
startNonterminal (CFG String
s [ProductionRule]
prules) = String
s 

nonterminals :: CFG -> [String]
nonterminals CFG
augCfg = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String
s] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
x | ProductionRule String
x [Symbol]
_ <- [ProductionRule]
prules]
  where
    CFG String
s [ProductionRule]
prules = CFG
augCfg

prodRuleToStr :: ProductionRule -> String
prodRuleToStr (ProductionRule String
s [Symbol]
syms) =
  String
"ProductionRule " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
    String -> ShowS
forall a. [a] -> [a] -> [a]
++  String
" [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ((Symbol -> String) -> [Symbol] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> String
symbolToStr [Symbol]
syms)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

symbolToStr :: Symbol -> String
symbolToStr (Nonterminal String
x) = String
"Nonterminal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
x
symbolToStr (Terminal String
x) = String
"Terminal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
x