module SequentialTypes where

import CodeSyntax
import CommonTypes
import Data.Array(Array)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Maybe(fromJust)
import Data.List(partition)

type Vertex    = Int
data PathStep  = AttrStep Vertex Vertex
               | AtOcStep Vertex Vertex
               | AttrIndu Vertex Vertex
               deriving (Int -> PathStep -> ShowS
[PathStep] -> ShowS
PathStep -> String
(Int -> PathStep -> ShowS)
-> (PathStep -> String) -> ([PathStep] -> ShowS) -> Show PathStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathStep] -> ShowS
$cshowList :: [PathStep] -> ShowS
show :: PathStep -> String
$cshow :: PathStep -> String
showsPrec :: Int -> PathStep -> ShowS
$cshowsPrec :: Int -> PathStep -> ShowS
Show, PathStep -> PathStep -> Bool
(PathStep -> PathStep -> Bool)
-> (PathStep -> PathStep -> Bool) -> Eq PathStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathStep -> PathStep -> Bool
$c/= :: PathStep -> PathStep -> Bool
== :: PathStep -> PathStep -> Bool
$c== :: PathStep -> PathStep -> Bool
Eq)
               
type Path      = [PathStep]
type Route     = [Vertex]
            
type Edge      = (Int,Int)
type EdgePath  = (Edge,Path)
type EdgePaths = (Edge,Path,Path)
type EdgeRoute = (Edge,Route)
type EdgeRoutes= (Edge,Route,Route)

type Table a   = Array     Vertex a


data ChildVisit = ChildVisit Identifier Identifier Int [Vertex] [Vertex] deriving (ChildVisit -> ChildVisit -> Bool
(ChildVisit -> ChildVisit -> Bool)
-> (ChildVisit -> ChildVisit -> Bool) -> Eq ChildVisit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChildVisit -> ChildVisit -> Bool
$c/= :: ChildVisit -> ChildVisit -> Bool
== :: ChildVisit -> ChildVisit -> Bool
$c== :: ChildVisit -> ChildVisit -> Bool
Eq,Int -> ChildVisit -> ShowS
[ChildVisit] -> ShowS
ChildVisit -> String
(Int -> ChildVisit -> ShowS)
-> (ChildVisit -> String)
-> ([ChildVisit] -> ShowS)
-> Show ChildVisit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChildVisit] -> ShowS
$cshowList :: [ChildVisit] -> ShowS
show :: ChildVisit -> String
$cshow :: ChildVisit -> String
showsPrec :: Int -> ChildVisit -> ShowS
$cshowsPrec :: Int -> ChildVisit -> ShowS
Show) -- field, rhs nt, visit nr., inh, syn

data NTAttr = NTAInh NontermIdent Identifier Type -- nt, attribute, type

            | NTASyn NontermIdent Identifier Type -- nt, attribute, type

               deriving Int -> NTAttr -> ShowS
[NTAttr] -> ShowS
NTAttr -> String
(Int -> NTAttr -> ShowS)
-> (NTAttr -> String) -> ([NTAttr] -> ShowS) -> Show NTAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NTAttr] -> ShowS
$cshowList :: [NTAttr] -> ShowS
show :: NTAttr -> String
$cshow :: NTAttr -> String
showsPrec :: Int -> NTAttr -> ShowS
$cshowsPrec :: Int -> NTAttr -> ShowS
Show

getNtaNameType :: NTAttr -> (Identifier, Type)
getNtaNameType :: NTAttr -> (Identifier, Type)
getNtaNameType (NTAInh Identifier
_ Identifier
name Type
tp) = (Identifier
name,Type
tp)
getNtaNameType (NTASyn Identifier
_ Identifier
name Type
tp) = (Identifier
name,Type
tp)

getAttr :: CRule -> Identifier
getAttr :: CRule -> Identifier
getAttr     (CRule Identifier
name Bool
_ Bool
_ Identifier
_ Identifier
_ Identifier
_ Maybe Identifier
_ Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
_ Maybe Identifier
_) = Identifier
name
getAttr     CRule
_ = String -> Identifier
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getIsIn :: CRule -> Bool
getIsIn :: CRule -> Bool
getIsIn     (CRule Identifier
_ Bool
ii Bool
_ Identifier
_ Identifier
_ Identifier
_ Maybe Identifier
_ Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
_ Maybe Identifier
_) = Bool
ii
getIsIn     CRule
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getHasCode :: CRule -> Bool
getHasCode :: CRule -> Bool
getHasCode  (CRule Identifier
_ Bool
_ Bool
hc Identifier
_ Identifier
_ Identifier
_ Maybe Identifier
_ Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
_ Maybe Identifier
_) = Bool
hc
getHasCode  CRule
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getLhsNt :: CRule -> NontermIdent
getLhsNt :: CRule -> Identifier
getLhsNt    (CRule Identifier
_ Bool
_ Bool
_ Identifier
nt Identifier
_ Identifier
_ Maybe Identifier
_ Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
_ Maybe Identifier
_) = Identifier
nt
getLhsNt    CRule
_ = String -> Identifier
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getCon :: CRule -> ConstructorIdent
getCon :: CRule -> Identifier
getCon      (CRule Identifier
_ Bool
_ Bool
_ Identifier
_ Identifier
con Identifier
_ Maybe Identifier
_ Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
_ Maybe Identifier
_) = Identifier
con
getCon      CRule
_ = String -> Identifier
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getField :: CRule -> Identifier
getField :: CRule -> Identifier
getField    (CRule Identifier
_ Bool
_ Bool
_ Identifier
_ Identifier
_ Identifier
field Maybe Identifier
_ Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
_ Maybe Identifier
_) = Identifier
field
getField    CRule
_ = String -> Identifier
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getRhsNt :: CRule -> Maybe NontermIdent
getRhsNt :: CRule -> Maybe Identifier
getRhsNt    (CRule Identifier
_ Bool
_ Bool
_ Identifier
_ Identifier
_ Identifier
_ Maybe Identifier
childnt Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
_ Maybe Identifier
_) = Maybe Identifier
childnt
getRhsNt    CRule
_ = String -> Maybe Identifier
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getType :: CRule -> Maybe Type
getType :: CRule -> Maybe Type
getType     (CRule Identifier
_ Bool
_ Bool
_ Identifier
_ Identifier
_ Identifier
_ Maybe Identifier
_ Maybe Type
tp Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
_ Maybe Identifier
_) = Maybe Type
tp
getType     CRule
_ = String -> Maybe Type
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getDefines :: CRule -> Map Int (Identifier, Identifier, Maybe Type)
getDefines :: CRule -> Map Int (Identifier, Identifier, Maybe Type)
getDefines  (CRule Identifier
_ Bool
_ Bool
_ Identifier
_ Identifier
_ Identifier
_ Maybe Identifier
_ Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
defines Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
_ Maybe Identifier
_) = Map Int (Identifier, Identifier, Maybe Type)
defines
getDefines  CRule
_ = String -> Map Int (Identifier, Identifier, Maybe Type)
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getUses :: CRule -> Set (Identifier, Identifier)
getUses :: CRule -> Set (Identifier, Identifier)
getUses     (CRule Identifier
_ Bool
_ Bool
_ Identifier
_ Identifier
_ Identifier
_ Maybe Identifier
_ Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
uses Bool
_ Maybe Identifier
_) = Set (Identifier, Identifier)
uses
getUses     CRule
_ = String -> Set (Identifier, Identifier)
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"
getExplicit :: CRule -> Bool
getExplicit :: CRule -> Bool
getExplicit (CRule Identifier
_ Bool
_ Bool
_ Identifier
_ Identifier
_ Identifier
_ Maybe Identifier
_ Maybe Type
_ Pattern
_ [String]
_ Map Int (Identifier, Identifier, Maybe Type)
_ Bool
_ String
_ Set (Identifier, Identifier)
_ Bool
expl Maybe Identifier
_) = Bool
expl
getExplicit CRule
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"Only defined for CRule"

isLocal, isInst, isLhs, isRhs, isSyn, isInh, hasCode :: CRule -> Bool
isLocal :: CRule -> Bool
isLocal = (Identifier
_LOCIdentifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
==) (Identifier -> Bool) -> (CRule -> Identifier) -> CRule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRule -> Identifier
getField
isInst :: CRule -> Bool
isInst = (Identifier
_INSTIdentifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
==) (Identifier -> Bool) -> (CRule -> Identifier) -> CRule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRule -> Identifier
getField
isLhs :: CRule -> Bool
isLhs = (Identifier
_LHSIdentifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
==) (Identifier -> Bool) -> (CRule -> Identifier) -> CRule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRule -> Identifier
getField
isRhs :: CRule -> Bool
isRhs CRule
cr = Bool -> Bool
not (CRule -> Bool
isLhs CRule
cr Bool -> Bool -> Bool
|| CRule -> Bool
isLocal CRule
cr)
isSyn :: CRule -> Bool
isSyn CRule
cr | CRule -> Bool
isLocal CRule
cr  = Bool
False
         | CRule -> Bool
getIsIn CRule
cr  = CRule -> Bool
isRhs CRule
cr
         | Bool
otherwise   = CRule -> Bool
isLhs CRule
cr
isInh :: CRule -> Bool
isInh = Bool -> Bool
not (Bool -> Bool) -> (CRule -> Bool) -> CRule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRule -> Bool
isSyn
hasCode :: CRule -> Bool
hasCode CRule
cr = CRule -> Bool
isLocal CRule
cr Bool -> Bool -> Bool
|| (CRule -> Bool
isLhs CRule
cr Bool -> Bool -> Bool
&& CRule -> Bool
isInh CRule
cr) Bool -> Bool -> Bool
|| (CRule -> Bool
isRhs CRule
cr Bool -> Bool -> Bool
&& CRule -> Bool
isSyn CRule
cr)

isEqualField, isDifferentField, isEqualCon, isRhsOfSameCon :: CRule -> CRule -> Bool
isEqualField :: CRule -> CRule -> Bool
isEqualField      CRule
a CRule
b = CRule -> CRule -> Bool
isEqualCon CRule
a CRule
b Bool -> Bool -> Bool
&& CRule -> Identifier
getField CRule
a Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== CRule -> Identifier
getField CRule
b
isDifferentField :: CRule -> CRule -> Bool
isDifferentField  CRule
a CRule
b = CRule -> CRule -> Bool
isEqualCon CRule
a CRule
b Bool -> Bool -> Bool
&& CRule -> Identifier
getField CRule
a Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= CRule -> Identifier
getField CRule
b 
isEqualCon :: CRule -> CRule -> Bool
isEqualCon        CRule
a CRule
b = CRule -> Identifier
getLhsNt CRule
a Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== CRule -> Identifier
getLhsNt CRule
b Bool -> Bool -> Bool
&& CRule -> Identifier
getCon CRule
a Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== CRule -> Identifier
getCon CRule
b
isRhsOfSameCon :: CRule -> CRule -> Bool
isRhsOfSameCon    CRule
a CRule
b = CRule -> CRule -> Bool
isEqualCon CRule
a CRule
b Bool -> Bool -> Bool
&& CRule -> Bool
isRhs CRule
a Bool -> Bool -> Bool
&& CRule -> Bool
isRhs CRule
b

isSynAttr, isInhAttr :: NTAttr -> Bool
isSynAttr :: NTAttr -> Bool
isSynAttr (NTAInh Identifier
_ Identifier
_ Type
_) = Bool
False
isSynAttr (NTASyn Identifier
_ Identifier
_ Type
_) = Bool
True
isInhAttr :: NTAttr -> Bool
isInhAttr = Bool -> Bool
not (Bool -> Bool) -> (NTAttr -> Bool) -> NTAttr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTAttr -> Bool
isSynAttr

ntattr :: CRule -> Maybe NTAttr
ntattr :: CRule -> Maybe NTAttr
ntattr CRule
cr  | CRule -> Bool
isLocal CRule
cr =  Maybe NTAttr
forall a. Maybe a
Nothing
           | CRule -> Bool
isInst  CRule
cr =  Maybe NTAttr
forall a. Maybe a
Nothing -- an inst definition is just considered as a local attribute definition

           | Bool
otherwise  =  let  at :: Identifier -> Identifier -> Type -> NTAttr
at = if CRule -> Bool
isSyn CRule
cr then Identifier -> Identifier -> Type -> NTAttr
NTASyn else Identifier -> Identifier -> Type -> NTAttr
NTAInh
                                getNt :: CRule -> Identifier
getNt CRule
cr' = if CRule -> Bool
isRhs CRule
cr' then Maybe Identifier -> Identifier
forall a. HasCallStack => Maybe a -> a
fromJust (CRule -> Maybe Identifier
getRhsNt CRule
cr') else CRule -> Identifier
getLhsNt CRule
cr'
                           in NTAttr -> Maybe NTAttr
forall a. a -> Maybe a
Just (Identifier -> Identifier -> Type -> NTAttr
at (CRule -> Identifier
getNt CRule
cr) (CRule -> Identifier
getAttr CRule
cr) (Maybe Type -> Type
forall a. HasCallStack => Maybe a -> a
fromJust (CRule -> Maybe Type
getType CRule
cr)))

cRuleLhsInh :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> CRule
cRuleLhsInh :: Identifier -> Identifier -> Identifier -> Type -> CRule
cRuleLhsInh Identifier
attr Identifier
nt Identifier
con Type
tp = Identifier
-> Bool
-> Bool
-> Identifier
-> Identifier
-> Identifier
-> Maybe Identifier
-> Maybe Type
-> Pattern
-> [String]
-> Map Int (Identifier, Identifier, Maybe Type)
-> Bool
-> String
-> Set (Identifier, Identifier)
-> Bool
-> Maybe Identifier
-> CRule
CRule Identifier
attr Bool
True Bool
False Identifier
nt Identifier
con Identifier
_LHS Maybe Identifier
forall a. Maybe a
Nothing (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
tp) (String -> Pattern
forall a. HasCallStack => String -> a
error String
"cRuleLhsInh") [] Map Int (Identifier, Identifier, Maybe Type)
forall k a. Map k a
Map.empty Bool
False String
"" Set (Identifier, Identifier)
forall a. Set a
Set.empty Bool
False Maybe Identifier
forall a. Maybe a
Nothing
cRuleTerminal :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> CRule
cRuleTerminal :: Identifier -> Identifier -> Identifier -> Type -> CRule
cRuleTerminal Identifier
attr Identifier
nt Identifier
con Type
tp = Identifier
-> Bool
-> Bool
-> Identifier
-> Identifier
-> Identifier
-> Maybe Identifier
-> Maybe Type
-> Pattern
-> [String]
-> Map Int (Identifier, Identifier, Maybe Type)
-> Bool
-> String
-> Set (Identifier, Identifier)
-> Bool
-> Maybe Identifier
-> CRule
CRule Identifier
attr Bool
True Bool
False Identifier
nt Identifier
con Identifier
_LOC Maybe Identifier
forall a. Maybe a
Nothing (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
tp) (String -> Pattern
forall a. HasCallStack => String -> a
error (String
"cRuleTerminal: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Identifier, Identifier, Identifier, Type) -> String
forall a. Show a => a -> String
show (Identifier
attr, Identifier
nt, Identifier
con, Type
tp))) [] Map Int (Identifier, Identifier, Maybe Type)
forall k a. Map k a
Map.empty Bool
False String
"" Set (Identifier, Identifier)
forall a. Set a
Set.empty Bool
False Maybe Identifier
forall a. Maybe a
Nothing
cRuleRhsSyn :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> Identifier -> NontermIdent -> CRule
cRuleRhsSyn :: Identifier
-> Identifier
-> Identifier
-> Type
-> Identifier
-> Identifier
-> CRule
cRuleRhsSyn Identifier
attr Identifier
nt Identifier
con Type
tp Identifier
field Identifier
childnt = Identifier
-> Bool
-> Bool
-> Identifier
-> Identifier
-> Identifier
-> Maybe Identifier
-> Maybe Type
-> Pattern
-> [String]
-> Map Int (Identifier, Identifier, Maybe Type)
-> Bool
-> String
-> Set (Identifier, Identifier)
-> Bool
-> Maybe Identifier
-> CRule
CRule Identifier
attr Bool
True Bool
False Identifier
nt Identifier
con Identifier
field (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
childnt) (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
tp) (String -> Pattern
forall a. HasCallStack => String -> a
error (String
"cRuleRhsSyn: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Identifier, Identifier, Identifier, Type, Identifier) -> String
forall a. Show a => a -> String
show (Identifier
attr, Identifier
nt, Identifier
con, Type
tp, Identifier
field))) [] Map Int (Identifier, Identifier, Maybe Type)
forall k a. Map k a
Map.empty Bool
False String
"" Set (Identifier, Identifier)
forall a. Set a
Set.empty Bool
False Maybe Identifier
forall a. Maybe a
Nothing

defaultRule :: Identifier -> NontermIdent -> ConstructorIdent -> Identifier -> CRule
defaultRule :: Identifier -> Identifier -> Identifier -> Identifier -> CRule
defaultRule Identifier
attr Identifier
nt Identifier
con Identifier
field =  Identifier
-> Bool
-> Bool
-> Identifier
-> Identifier
-> Identifier
-> Maybe Identifier
-> Maybe Type
-> Pattern
-> [String]
-> Map Int (Identifier, Identifier, Maybe Type)
-> Bool
-> String
-> Set (Identifier, Identifier)
-> Bool
-> Maybe Identifier
-> CRule
CRule Identifier
attr (Int -> Bool
forall a. Int -> a
er Int
1) (Int -> Bool
forall a. Int -> a
er Int
2) Identifier
nt Identifier
con Identifier
field (Int -> Maybe Identifier
forall a. Int -> a
er Int
3) (Int -> Maybe Type
forall a. Int -> a
er Int
4) (Int -> Pattern
forall a. Int -> a
er Int
5) (Int -> [String]
forall a. Int -> a
er Int
6) (Int -> Map Int (Identifier, Identifier, Maybe Type)
forall a. Int -> a
er Int
7) (Int -> Bool
forall a. Int -> a
er Int
8) (Int -> String
forall a. Int -> a
er Int
9) (Int -> Set (Identifier, Identifier)
forall a. Int -> a
er Int
10) Bool
False Maybe Identifier
forall a. Maybe a
Nothing
                                 where er :: Int -> a
                                       er :: Int -> a
er Int
i = String -> a
forall a. HasCallStack => String -> a
error (String
"Default rule has no code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)

instance Eq CRule where
  CRule
a == :: CRule -> CRule -> Bool
== CRule
b = CRule -> Identifier
getAttr CRule
a Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== CRule -> Identifier
getAttr CRule
b Bool -> Bool -> Bool
&& CRule -> CRule -> Bool
isEqualField CRule
a CRule
b
instance Ord CRule where
  compare :: CRule -> CRule -> Ordering
compare CRule
a CRule
b =  Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CRule -> Identifier
getLhsNt CRule
a) (CRule -> Identifier
getLhsNt CRule
b) 
                 Ordering -> Ordering -> Ordering
>/< Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CRule -> Identifier
getCon CRule
a) (CRule -> Identifier
getCon CRule
b)
                 Ordering -> Ordering -> Ordering
>/< Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CRule -> Identifier
getField CRule
a) (CRule -> Identifier
getField CRule
b)
                 Ordering -> Ordering -> Ordering
>/< Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CRule -> Identifier
getAttr CRule
a) (CRule -> Identifier
getAttr CRule
b)
instance Eq NTAttr where
  (NTAInh Identifier
_ Identifier
_ Type
_) == :: NTAttr -> NTAttr -> Bool
== (NTASyn Identifier
_ Identifier
_ Type
_) = Bool
False
  (NTASyn Identifier
_ Identifier
_ Type
_) == (NTAInh Identifier
_ Identifier
_ Type
_) = Bool
False
  (NTAInh Identifier
nt Identifier
name Type
_) == (NTAInh Identifier
nt' Identifier
name' Type
_) = Identifier
nt Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
nt' Bool -> Bool -> Bool
&& Identifier
name Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
name'
  (NTASyn Identifier
nt Identifier
name Type
_) == (NTASyn Identifier
nt' Identifier
name' Type
_) = Identifier
nt Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
nt' Bool -> Bool -> Bool
&& Identifier
name Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
name'
instance Ord NTAttr where
  compare :: NTAttr -> NTAttr -> Ordering
compare (NTAInh Identifier
_ Identifier
_ Type
_) (NTASyn Identifier
_ Identifier
_ Type
_) = Ordering
LT
  compare (NTASyn Identifier
_ Identifier
_ Type
_) (NTAInh Identifier
_ Identifier
_ Type
_) = Ordering
GT
  compare (NTAInh Identifier
nt Identifier
name Type
_) (NTAInh Identifier
nt' Identifier
name' Type
_) = Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Identifier
nt Identifier
nt' Ordering -> Ordering -> Ordering
>/< Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Identifier
name Identifier
name'
  compare (NTASyn Identifier
nt Identifier
name Type
_) (NTASyn Identifier
nt' Identifier
name' Type
_) = Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Identifier
nt Identifier
nt' Ordering -> Ordering -> Ordering
>/< Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Identifier
name Identifier
name'

eqCRuleDefines :: CRule -> CRule -> Bool
eqCRuleDefines :: CRule -> CRule -> Bool
eqCRuleDefines CRule
a CRule
b
  = Map Int (Identifier, Identifier, Maybe Type) -> [Int]
forall k a. Map k a -> [k]
Map.keys (CRule -> Map Int (Identifier, Identifier, Maybe Type)
getDefines CRule
a) [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== Map Int (Identifier, Identifier, Maybe Type) -> [Int]
forall k a. Map k a -> [k]
Map.keys (CRule -> Map Int (Identifier, Identifier, Maybe Type)
getDefines CRule
b)

(>/<) :: Ordering -> Ordering -> Ordering
Ordering
EQ >/< :: Ordering -> Ordering -> Ordering
>/< Ordering
b = Ordering
b
Ordering
a >/< Ordering
_ = Ordering
a


eqClasses :: (a -> a -> Bool) -> [a] -> [[a]]
eqClasses :: (a -> a -> Bool) -> [a] -> [[a]]
eqClasses a -> a -> Bool
_ [] = []
eqClasses a -> a -> Bool
p (a
a:[a]
as) = let ([a]
isA,[a]
rest) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (a -> a -> Bool
p a
a) [a]
as
                     in (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
isA)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:(a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
eqClasses a -> a -> Bool
p [a]
rest

lhsshow :: Options -> NTAttr -> String
lhsshow :: Options -> NTAttr -> String
lhsshow Options
opts (NTAInh Identifier
_ Identifier
attr Type
_) = Options -> Bool -> Identifier -> String
lhsname Options
opts Bool
True Identifier
attr
lhsshow Options
opts (NTASyn Identifier
_ Identifier
attr Type
_) = Options -> Bool -> Identifier -> String
lhsname Options
opts Bool
False Identifier
attr 

rhsshow :: Options -> Identifier -> NTAttr -> String
rhsshow :: Options -> Identifier -> NTAttr -> String
rhsshow Options
opts Identifier
field (NTAInh Identifier
_ Identifier
attr Type
_) = Options -> Bool -> Identifier -> Identifier -> String
attrname Options
opts Bool
False Identifier
field Identifier
attr
rhsshow Options
opts Identifier
field (NTASyn Identifier
_ Identifier
attr Type
_) = Options -> Bool -> Identifier -> Identifier -> String
attrname Options
opts Bool
True Identifier
field Identifier
attr 

prettyCRule :: CRule -> String
prettyCRule :: CRule -> String
prettyCRule CRule
cr 
   =  let descr :: String
descr | CRule -> Bool
isLocal CRule
cr = String
"local attribute " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show (CRule -> Identifier
getAttr CRule
cr)
                | Bool
otherwise =     (if CRule -> Bool
isSyn CRule
cr then String
"synthesized " else String
"inherited ")
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"attribute "
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if CRule -> Bool
isRhs CRule
cr then Identifier -> String
forall a. Show a => a -> String
show (CRule -> Identifier
getField CRule
cr) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." else String
"")
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if CRule -> Bool
isLhs CRule
cr then String
"lhs." else String
"")
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Identifier -> String
forall a. Show a => a -> String
show (CRule -> Identifier
getAttr CRule
cr))
      in Identifier -> String
forall a. Show a => a -> String
show (CRule -> Identifier
getLhsNt CRule
cr) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show (CRule -> Identifier
getCon CRule
cr) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
descr