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
(Vertex -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NontermIdent -> String
forall a. Show a => a -> String
show NontermIdent
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" nt: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NontermIdent -> String
forall a. Show a => a -> String
show NontermIdent
nt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" con: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NontermIdent -> String
forall a. Show a => a -> String
show NontermIdent
con String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" field: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NontermIdent -> String
forall a. Show a => a -> String
show NontermIdent
field
         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" childnt: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe NontermIdent -> String
forall a. Show a => a -> String
show Maybe NontermIdent
childnt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" rhs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
rhs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" uses: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
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) <- Set (NontermIdent, NontermIdent) -> [(NontermIdent, NontermIdent)]
forall a. Set a -> [a]
Set.toList Set (NontermIdent, NontermIdent)
uses ]
       show CRule
_ = ShowS
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'     = ((NontermIdent, Type) -> (String, String))
-> [(NontermIdent, Type)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (NontermIdent, Type) -> (String, String)
toString (Attributes -> [(NontermIdent, Type)]
forall k a. Map k a -> [(k, a)]
Map.toList Attributes
syn)
         inh' :: [(String, String)]
inh'     = ((NontermIdent, Type) -> (String, String))
-> [(NontermIdent, Type)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (NontermIdent, Type) -> (String, String)
toString (Attributes -> [(NontermIdent, Type)]
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
tps; Haskell String
t' -> String
t'; Type
Self -> ShowS
forall a. HasCallStack => String -> a
error String
"Self type not supported.")
         chnn :: [(String, String)]
chnn     = [(String, String)]
inh' [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [(String, String)]
syn'
         inhn :: [(String, String)]
inhn     = [(String, String)]
inh' [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(String, String)]
chnn
         synn :: [(String, String)]
synn     = [(String, String)]
syn' [(String, String)] -> [(String, String)] -> [(String, String)]
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ if [(String, String)] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [(String, String)]
as Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
1 then String
" attribute:" else String
" attributes:") String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                         ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,String
y) -> ShowS
ind String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> Char -> String
forall a. Vertex -> a -> [a]
replicate ((Vertex
20 Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
- String -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length String
x) Vertex -> Vertex -> Vertex
forall a. Ord a => a -> a -> a
`max` Vertex
0) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y) [(String, String)]
as
     in  String -> [(String, String)] -> [String]
disp String
"inherited" [(String, String)]
inhn
         [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [(String, String)] -> [String]
disp String
"chained" [(String, String)]
chnn
         [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [(String, String)] -> [String]
disp String
"synthesized" [(String, String)]
synn