module GrammarInfo where

import SequentialTypes
import CodeSyntax
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Set(Set)
import qualified Data.Set as Set
import CommonTypes
import Data.List(intersect,(\\))
import Options

type LMH = (Vertex,Vertex,Vertex)
data Info = Info  {  Info -> Table Vertex
tdpToTds    ::  Table Vertex
                  ,  Info -> Table [Vertex]
tdsToTdp    ::  Table [Vertex]
                  ,  Info -> Table NTAttr
attrTable   ::  Table NTAttr
                  ,  Info -> Table CRule
ruleTable   ::  Table CRule
                  ,  Info -> [LMH]
lmh         ::  [LMH]
                  ,  Info -> [(NontermIdent, [NontermIdent])]
nonts       ::  [(NontermIdent,[ConstructorIdent])]
                  ,  Info -> Set NontermIdent
wraps       ::  Set NontermIdent
                  }
                  deriving Vertex -> Info -> ShowS
[Info] -> ShowS
Info -> String
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info] -> ShowS
$cshowList :: [Info] -> ShowS
show :: Info -> String
$cshow :: Info -> String
showsPrec :: Vertex -> Info -> ShowS
$cshowsPrec :: Vertex -> Info -> ShowS
Show

instance Show CRule
 where show :: CRule -> String
show (CRule NontermIdent
name Bool
_ Bool
_ NontermIdent
nt NontermIdent
con NontermIdent
field Maybe NontermIdent
childnt Maybe Type
_ Pattern
_ [String]
rhs Map Vertex (NontermIdent, NontermIdent, Maybe Type)
_ Bool
_ String
_ Set (NontermIdent, NontermIdent)
uses Bool
_ Maybe NontermIdent
_)
         = String
"CRule " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NontermIdent
name forall a. [a] -> [a] -> [a]
++ String
" nt: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NontermIdent
nt forall a. [a] -> [a] -> [a]
++ String
" con: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NontermIdent
con forall a. [a] -> [a] -> [a]
++ String
" field: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NontermIdent
field
         forall a. [a] -> [a] -> [a]
++ String
" childnt: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe NontermIdent
childnt forall a. [a] -> [a] -> [a]
++ String
" rhs: " forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
rhs forall a. [a] -> [a] -> [a]
++ String
" uses: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [ Options -> Bool -> NontermIdent -> NontermIdent -> String
attrname Options
noOptions Bool
True NontermIdent
fld NontermIdent
nm | (NontermIdent
fld,NontermIdent
nm) <- forall a. Set a -> [a]
Set.toList Set (NontermIdent, NontermIdent)
uses ]
       show CRule
_ = forall a. HasCallStack => String -> a
error String
"Only CRule is supported"

type CInterfaceMap = Map NontermIdent CInterface
type CVisitsMap = Map NontermIdent (Map ConstructorIdent CVisits)

data CycleStatus
  = CycleFree     CInterfaceMap CVisitsMap
  | LocalCycle    [Route]
  | InstCycle     [Route]
  | DirectCycle   [EdgeRoutes]
  | InducedCycle  CInterfaceMap [EdgeRoutes]

showsSegment :: CSegment -> [String]
showsSegment :: CSegment -> [String]
showsSegment (CSegment Attributes
inh Attributes
syn)
   = let syn' :: [(String, String)]
syn'     = forall a b. (a -> b) -> [a] -> [b]
map (NontermIdent, Type) -> (String, String)
toString (forall k a. Map k a -> [(k, a)]
Map.toList Attributes
syn)
         inh' :: [(String, String)]
inh'     = forall a b. (a -> b) -> [a] -> [b]
map (NontermIdent, Type) -> (String, String)
toString (forall k a. Map k a -> [(k, a)]
Map.toList Attributes
inh)
         toString :: (NontermIdent, Type) -> (String, String)
toString (NontermIdent
a,Type
t) = (NontermIdent -> String
getName NontermIdent
a, case Type
t of (NT NontermIdent
nt [String]
tps Bool
_) -> NontermIdent -> String
getName NontermIdent
nt forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
tps; Haskell String
t' -> String
t'; Type
Self -> forall a. HasCallStack => String -> a
error String
"Self type not supported.")
         chnn :: [(String, String)]
chnn     = [(String, String)]
inh' forall a. Eq a => [a] -> [a] -> [a]
`intersect` [(String, String)]
syn'
         inhn :: [(String, String)]
inhn     = [(String, String)]
inh' forall a. Eq a => [a] -> [a] -> [a]
\\ [(String, String)]
chnn
         synn :: [(String, String)]
synn     = [(String, String)]
syn' forall a. Eq a => [a] -> [a] -> [a]
\\ [(String, String)]
chnn
         disp :: String -> [(String, String)] -> [String]
disp String
_ [] = []
         disp String
name [(String, String)]
as =  (String
name forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [(String, String)]
as forall a. Eq a => a -> a -> Bool
== Vertex
1 then String
" attribute:" else String
" attributes:") forall a. a -> [a] -> [a]
:
                         forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,String
y) -> ShowS
ind String
x forall a. [a] -> [a] -> [a]
++ forall a. Vertex -> a -> [a]
replicate ((Vertex
20 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Vertex
length String
x) forall a. Ord a => a -> a -> a
`max` Vertex
0) Char
' ' forall a. [a] -> [a] -> [a]
++ String
" : " forall a. [a] -> [a] -> [a]
++ String
y) [(String, String)]
as
     in  String -> [(String, String)] -> [String]
disp String
"inherited" [(String, String)]
inhn
         forall a. [a] -> [a] -> [a]
++ String -> [(String, String)] -> [String]
disp String
"chained" [(String, String)]
chnn
         forall a. [a] -> [a] -> [a]
++ String -> [(String, String)] -> [String]
disp String
"synthesized" [(String, String)]
synn