module Language.VHDL.Syntax where

--------------------------------------------------------------------------------
--
--                                   -- 1 --
--
--                      Design entities and configurations
--
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- * 1.1 Entiity Declarations
--------------------------------------------------------------------------------
{-
    entity_declaration ::=
      ENTITY identifier IS
        entity_header
        entity_declarative_part
      [ BEGIN
        entity_statement_part ]
      END [ ENTITY ] [ entity_simple_name ] ;
-}

data EntityDeclaration = EntityDeclaration {
    EntityDeclaration -> Identifier
entity_identifier         :: Identifier
  , EntityDeclaration -> EntityHeader
entity_header             :: EntityHeader
  , EntityDeclaration -> EntityDeclarativePart
entity_declarative_part   :: EntityDeclarativePart
  , EntityDeclaration -> Maybe EntityStatementPart
entity_statement_part     :: Maybe EntityStatementPart
  }
  deriving (EntityDeclaration -> EntityDeclaration -> Bool
(EntityDeclaration -> EntityDeclaration -> Bool)
-> (EntityDeclaration -> EntityDeclaration -> Bool)
-> Eq EntityDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityDeclaration -> EntityDeclaration -> Bool
$c/= :: EntityDeclaration -> EntityDeclaration -> Bool
== :: EntityDeclaration -> EntityDeclaration -> Bool
$c== :: EntityDeclaration -> EntityDeclaration -> Bool
Eq, Int -> EntityDeclaration -> ShowS
[EntityDeclaration] -> ShowS
EntityDeclaration -> String
(Int -> EntityDeclaration -> ShowS)
-> (EntityDeclaration -> String)
-> ([EntityDeclaration] -> ShowS)
-> Show EntityDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityDeclaration] -> ShowS
$cshowList :: [EntityDeclaration] -> ShowS
show :: EntityDeclaration -> String
$cshow :: EntityDeclaration -> String
showsPrec :: Int -> EntityDeclaration -> ShowS
$cshowsPrec :: Int -> EntityDeclaration -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 1.1.1 Entity haeder
{-
    entity_header ::=
      [ formal_generic_clause ]
      [ formal_port_clause ]

    generic_clause ::= GENERIC ( generic_list ) ;
    port_clause    ::= PORT ( port_list ) ;
-}

data EntityHeader = EntityHeader {
    EntityHeader -> Maybe GenericClause
formal_generic_clause     :: Maybe GenericClause
  , EntityHeader -> Maybe PortClause
formal_port_clause        :: Maybe PortClause
  }
  deriving (EntityHeader -> EntityHeader -> Bool
(EntityHeader -> EntityHeader -> Bool)
-> (EntityHeader -> EntityHeader -> Bool) -> Eq EntityHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityHeader -> EntityHeader -> Bool
$c/= :: EntityHeader -> EntityHeader -> Bool
== :: EntityHeader -> EntityHeader -> Bool
$c== :: EntityHeader -> EntityHeader -> Bool
Eq, Int -> EntityHeader -> ShowS
[EntityHeader] -> ShowS
EntityHeader -> String
(Int -> EntityHeader -> ShowS)
-> (EntityHeader -> String)
-> ([EntityHeader] -> ShowS)
-> Show EntityHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityHeader] -> ShowS
$cshowList :: [EntityHeader] -> ShowS
show :: EntityHeader -> String
$cshow :: EntityHeader -> String
showsPrec :: Int -> EntityHeader -> ShowS
$cshowsPrec :: Int -> EntityHeader -> ShowS
Show)

data GenericClause = GenericClause GenericList
  deriving (GenericClause -> GenericClause -> Bool
(GenericClause -> GenericClause -> Bool)
-> (GenericClause -> GenericClause -> Bool) -> Eq GenericClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericClause -> GenericClause -> Bool
$c/= :: GenericClause -> GenericClause -> Bool
== :: GenericClause -> GenericClause -> Bool
$c== :: GenericClause -> GenericClause -> Bool
Eq, Int -> GenericClause -> ShowS
[GenericClause] -> ShowS
GenericClause -> String
(Int -> GenericClause -> ShowS)
-> (GenericClause -> String)
-> ([GenericClause] -> ShowS)
-> Show GenericClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericClause] -> ShowS
$cshowList :: [GenericClause] -> ShowS
show :: GenericClause -> String
$cshow :: GenericClause -> String
showsPrec :: Int -> GenericClause -> ShowS
$cshowsPrec :: Int -> GenericClause -> ShowS
Show)

data PortClause    = PortClause    PortList
  deriving (PortClause -> PortClause -> Bool
(PortClause -> PortClause -> Bool)
-> (PortClause -> PortClause -> Bool) -> Eq PortClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortClause -> PortClause -> Bool
$c/= :: PortClause -> PortClause -> Bool
== :: PortClause -> PortClause -> Bool
$c== :: PortClause -> PortClause -> Bool
Eq, Int -> PortClause -> ShowS
[PortClause] -> ShowS
PortClause -> String
(Int -> PortClause -> ShowS)
-> (PortClause -> String)
-> ([PortClause] -> ShowS)
-> Show PortClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortClause] -> ShowS
$cshowList :: [PortClause] -> ShowS
show :: PortClause -> String
$cshow :: PortClause -> String
showsPrec :: Int -> PortClause -> ShowS
$cshowsPrec :: Int -> PortClause -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 1.1.1.1 Generics
{-
    generic_list ::= generic_interface_list
-}

type GenericList = InterfaceList

--------------------------------------------------------------------------------
-- *** 1.1.1.2 Ports
{-
    port_list ::= port_interface_list
-}

type PortList = InterfaceList

--------------------------------------------------------------------------------
-- ** 1.1.2 Entity declarative part
{-
    entity_declarative_part ::=
      { entity_declarative_item }

    entity_declarative_item ::=
        subprogram_declaration
      | subprogram_body
      | type_declaration
      | subtype_declaration
      | constant_declaration
      | signal_declaration
      | shared_variable_declaration
      | file_declaration
      | alias_declaration
      | attribute_declaration
      | attribute_specification
      | disconnection_specification
      | use_clause
      | group_template_declaration
      | group_declaration
-}

type EntityDeclarativePart = [EntityDeclarativeItem]

data EntityDeclarativeItem =
    EDISubprogDecl  SubprogramDeclaration
  | EDISubprogBody  SubprogramBody
  | EDIType         TypeDeclaration
  | EDISubtype      SubtypeDeclaration
  | EDIConstant     ConstantDeclaration
  | EDISignal       SignalDeclaration
  | EDIShared       VariableDeclaration
  | EDIFile         FileDeclaration
  | EDIAlias        AliasDeclaration
  | EDIAttrDecl     AttributeDeclaration
  | EDIAttrSpec     AttributeSpecification
  | EDIDiscSpec     DisconnectionSpecification
  | EDIUseClause    UseClause
  | EDIGroupTemp    GroupTemplateDeclaration
  | EDIGroup        GroupDeclaration
  deriving (EntityDeclarativeItem -> EntityDeclarativeItem -> Bool
(EntityDeclarativeItem -> EntityDeclarativeItem -> Bool)
-> (EntityDeclarativeItem -> EntityDeclarativeItem -> Bool)
-> Eq EntityDeclarativeItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityDeclarativeItem -> EntityDeclarativeItem -> Bool
$c/= :: EntityDeclarativeItem -> EntityDeclarativeItem -> Bool
== :: EntityDeclarativeItem -> EntityDeclarativeItem -> Bool
$c== :: EntityDeclarativeItem -> EntityDeclarativeItem -> Bool
Eq, Int -> EntityDeclarativeItem -> ShowS
EntityDeclarativePart -> ShowS
EntityDeclarativeItem -> String
(Int -> EntityDeclarativeItem -> ShowS)
-> (EntityDeclarativeItem -> String)
-> (EntityDeclarativePart -> ShowS)
-> Show EntityDeclarativeItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: EntityDeclarativePart -> ShowS
$cshowList :: EntityDeclarativePart -> ShowS
show :: EntityDeclarativeItem -> String
$cshow :: EntityDeclarativeItem -> String
showsPrec :: Int -> EntityDeclarativeItem -> ShowS
$cshowsPrec :: Int -> EntityDeclarativeItem -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 1.1.3 Entity statement part
{-
    entity_statement_part ::=
      { entity_statement }

    entity_statement ::=
        concurrent_assertion_statement
      | passive_concurrent_procedure_call_statement
      | passive_process_statement
-}

type EntityStatementPart = [EntityStatement]

data EntityStatement =
    ESConcAssert   ConcurrentAssertionStatement
  | ESPassiveConc  ConcurrentProcedureCallStatement
  | ESPassiveProc  ProcessStatement
  deriving (EntityStatement -> EntityStatement -> Bool
(EntityStatement -> EntityStatement -> Bool)
-> (EntityStatement -> EntityStatement -> Bool)
-> Eq EntityStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityStatement -> EntityStatement -> Bool
$c/= :: EntityStatement -> EntityStatement -> Bool
== :: EntityStatement -> EntityStatement -> Bool
$c== :: EntityStatement -> EntityStatement -> Bool
Eq, Int -> EntityStatement -> ShowS
EntityStatementPart -> ShowS
EntityStatement -> String
(Int -> EntityStatement -> ShowS)
-> (EntityStatement -> String)
-> (EntityStatementPart -> ShowS)
-> Show EntityStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: EntityStatementPart -> ShowS
$cshowList :: EntityStatementPart -> ShowS
show :: EntityStatement -> String
$cshow :: EntityStatement -> String
showsPrec :: Int -> EntityStatement -> ShowS
$cshowsPrec :: Int -> EntityStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 1.2 Arcitecture bodies
--------------------------------------------------------------------------------
{-
    architecture_body ::=
      ARCHITECTURE identifier OF entity_name IS
        architecture_declarative_part
      BEGIN
	architecture_statement_part
      END [ ARCHITECTURE ] [ architecture_simple_name ] ;
-}

data ArchitectureBody = ArchitectureBody {
    ArchitectureBody -> Identifier
archi_identifier       :: Identifier
  , ArchitectureBody -> Name
archi_entity_name      :: Name
  , ArchitectureBody -> ArchitectureDeclarativePart
archi_declarative_part :: ArchitectureDeclarativePart
  , ArchitectureBody -> ArchitectureStatementPart
archi_statement_part   :: ArchitectureStatementPart
  }
  deriving (ArchitectureBody -> ArchitectureBody -> Bool
(ArchitectureBody -> ArchitectureBody -> Bool)
-> (ArchitectureBody -> ArchitectureBody -> Bool)
-> Eq ArchitectureBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArchitectureBody -> ArchitectureBody -> Bool
$c/= :: ArchitectureBody -> ArchitectureBody -> Bool
== :: ArchitectureBody -> ArchitectureBody -> Bool
$c== :: ArchitectureBody -> ArchitectureBody -> Bool
Eq, Int -> ArchitectureBody -> ShowS
[ArchitectureBody] -> ShowS
ArchitectureBody -> String
(Int -> ArchitectureBody -> ShowS)
-> (ArchitectureBody -> String)
-> ([ArchitectureBody] -> ShowS)
-> Show ArchitectureBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArchitectureBody] -> ShowS
$cshowList :: [ArchitectureBody] -> ShowS
show :: ArchitectureBody -> String
$cshow :: ArchitectureBody -> String
showsPrec :: Int -> ArchitectureBody -> ShowS
$cshowsPrec :: Int -> ArchitectureBody -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 1.2.1 Architecture declarative part
{-
    architecture_declarative_part ::=
      { block_declarative_item }

    block_declarative_item ::=
        subprogram_declaration
      | subprogram_body
      | type_declaration
      | subtype_declaration
      | constant_declaration
      | signal_declaration
      | shared_variable_declaration
      | file_declaration
      | alias_declaration
      | component_declaration
      | attribute_declaration
      | attribute_specification
      | configuration_specification
      | disconnection_specification
      | use_clause
      | group_template_declaration
      | group_declaration
-}

type ArchitectureDeclarativePart = [BlockDeclarativeItem]

data BlockDeclarativeItem =
    BDISubprogDecl  SubprogramDeclaration
  | BDISubprogBody  SubprogramBody
  | BDIType         TypeDeclaration
  | BDISubtype      SubtypeDeclaration
  | BDIConstant     ConstantDeclaration
  | BDISignal       SignalDeclaration
  | BDIShared       VariableDeclaration
  | BDIFile         FileDeclaration
  | BDIAlias        AliasDeclaration
  | BDIComp         ComponentDeclaration
  | BDIAttrDecl     AttributeDeclaration
  | BDIAttrSpec     AttributeSpecification
  | BDIConfigSpec   ConfigurationSpecification
  | BDIDisconSpec   DisconnectionSpecification
  | BDIUseClause    UseClause
  | BDIGroupTemp    GroupTemplateDeclaration
  | BDIGroup        GroupDeclaration
  deriving (BlockDeclarativeItem -> BlockDeclarativeItem -> Bool
(BlockDeclarativeItem -> BlockDeclarativeItem -> Bool)
-> (BlockDeclarativeItem -> BlockDeclarativeItem -> Bool)
-> Eq BlockDeclarativeItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockDeclarativeItem -> BlockDeclarativeItem -> Bool
$c/= :: BlockDeclarativeItem -> BlockDeclarativeItem -> Bool
== :: BlockDeclarativeItem -> BlockDeclarativeItem -> Bool
$c== :: BlockDeclarativeItem -> BlockDeclarativeItem -> Bool
Eq, Int -> BlockDeclarativeItem -> ShowS
ArchitectureDeclarativePart -> ShowS
BlockDeclarativeItem -> String
(Int -> BlockDeclarativeItem -> ShowS)
-> (BlockDeclarativeItem -> String)
-> (ArchitectureDeclarativePart -> ShowS)
-> Show BlockDeclarativeItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: ArchitectureDeclarativePart -> ShowS
$cshowList :: ArchitectureDeclarativePart -> ShowS
show :: BlockDeclarativeItem -> String
$cshow :: BlockDeclarativeItem -> String
showsPrec :: Int -> BlockDeclarativeItem -> ShowS
$cshowsPrec :: Int -> BlockDeclarativeItem -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 1.2.2 Architecture statement part
{-
    architecture_statement_part ::=
      { concurrent_statement }
-}

type ArchitectureStatementPart = [ConcurrentStatement]

--------------------------------------------------------------------------------
-- * 1.3 Configuration declarations
--------------------------------------------------------------------------------
{-
    configuration_declaration ::=
      CONFIGURATION identifier OF entity_name IS
        configuration_declarative_part
	block_configuration
      END [ CONFIGURATION ] [ configuration_simple_name ] ;

    configuration_declarative_part ::=
      { configuration_declarative_item }

    configuration_declarative_item ::=
	use_clause
      | attribute_specification
      | group_declaration
-}

data ConfigurationDeclaration = ConfigurationDeclaration {
    ConfigurationDeclaration -> Identifier
config_identifier          :: Identifier
  , ConfigurationDeclaration -> Name
config_entity_name         :: Name
  , ConfigurationDeclaration -> ConfigurationDeclarativePart
config_declarative_part    :: ConfigurationDeclarativePart
  , ConfigurationDeclaration -> BlockConfiguration
config_block_configuration :: BlockConfiguration
  }
  deriving (ConfigurationDeclaration -> ConfigurationDeclaration -> Bool
(ConfigurationDeclaration -> ConfigurationDeclaration -> Bool)
-> (ConfigurationDeclaration -> ConfigurationDeclaration -> Bool)
-> Eq ConfigurationDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationDeclaration -> ConfigurationDeclaration -> Bool
$c/= :: ConfigurationDeclaration -> ConfigurationDeclaration -> Bool
== :: ConfigurationDeclaration -> ConfigurationDeclaration -> Bool
$c== :: ConfigurationDeclaration -> ConfigurationDeclaration -> Bool
Eq, Int -> ConfigurationDeclaration -> ShowS
[ConfigurationDeclaration] -> ShowS
ConfigurationDeclaration -> String
(Int -> ConfigurationDeclaration -> ShowS)
-> (ConfigurationDeclaration -> String)
-> ([ConfigurationDeclaration] -> ShowS)
-> Show ConfigurationDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationDeclaration] -> ShowS
$cshowList :: [ConfigurationDeclaration] -> ShowS
show :: ConfigurationDeclaration -> String
$cshow :: ConfigurationDeclaration -> String
showsPrec :: Int -> ConfigurationDeclaration -> ShowS
$cshowsPrec :: Int -> ConfigurationDeclaration -> ShowS
Show)

type ConfigurationDeclarativePart = [ConfigurationDeclarativeItem]

data ConfigurationDeclarativeItem =
    CDIUse       UseClause
  | CDIAttrSpec  AttributeSpecification
  | CDIGroup     GroupDeclaration
  deriving (ConfigurationDeclarativeItem
-> ConfigurationDeclarativeItem -> Bool
(ConfigurationDeclarativeItem
 -> ConfigurationDeclarativeItem -> Bool)
-> (ConfigurationDeclarativeItem
    -> ConfigurationDeclarativeItem -> Bool)
-> Eq ConfigurationDeclarativeItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationDeclarativeItem
-> ConfigurationDeclarativeItem -> Bool
$c/= :: ConfigurationDeclarativeItem
-> ConfigurationDeclarativeItem -> Bool
== :: ConfigurationDeclarativeItem
-> ConfigurationDeclarativeItem -> Bool
$c== :: ConfigurationDeclarativeItem
-> ConfigurationDeclarativeItem -> Bool
Eq, Int -> ConfigurationDeclarativeItem -> ShowS
ConfigurationDeclarativePart -> ShowS
ConfigurationDeclarativeItem -> String
(Int -> ConfigurationDeclarativeItem -> ShowS)
-> (ConfigurationDeclarativeItem -> String)
-> (ConfigurationDeclarativePart -> ShowS)
-> Show ConfigurationDeclarativeItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: ConfigurationDeclarativePart -> ShowS
$cshowList :: ConfigurationDeclarativePart -> ShowS
show :: ConfigurationDeclarativeItem -> String
$cshow :: ConfigurationDeclarativeItem -> String
showsPrec :: Int -> ConfigurationDeclarativeItem -> ShowS
$cshowsPrec :: Int -> ConfigurationDeclarativeItem -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 1.3.1 Block configuration
{-
    block_configuration ::=
      FOR block_specification
        { use_clause }
	{ configuration_item }
      END FOR ;

    block_specification ::=
        architecture_name
      | block_statement_label
      | generate_statement_label [ ( index_specification ) ]

    index_specification ::=
        discrete_range
      | static_expression

    configuration_item ::=
        block_configuration
      | component_configuration
-}

data BlockConfiguration = BlockConfiguration {
    BlockConfiguration -> BlockSpecification
block_specification      :: BlockSpecification
  , BlockConfiguration -> [UseClause]
block_use_clause         :: [UseClause]
  , BlockConfiguration -> [ConfigurationItem]
block_configuration_item :: [ConfigurationItem]
  }
  deriving (BlockConfiguration -> BlockConfiguration -> Bool
(BlockConfiguration -> BlockConfiguration -> Bool)
-> (BlockConfiguration -> BlockConfiguration -> Bool)
-> Eq BlockConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockConfiguration -> BlockConfiguration -> Bool
$c/= :: BlockConfiguration -> BlockConfiguration -> Bool
== :: BlockConfiguration -> BlockConfiguration -> Bool
$c== :: BlockConfiguration -> BlockConfiguration -> Bool
Eq, Int -> BlockConfiguration -> ShowS
[BlockConfiguration] -> ShowS
BlockConfiguration -> String
(Int -> BlockConfiguration -> ShowS)
-> (BlockConfiguration -> String)
-> ([BlockConfiguration] -> ShowS)
-> Show BlockConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockConfiguration] -> ShowS
$cshowList :: [BlockConfiguration] -> ShowS
show :: BlockConfiguration -> String
$cshow :: BlockConfiguration -> String
showsPrec :: Int -> BlockConfiguration -> ShowS
$cshowsPrec :: Int -> BlockConfiguration -> ShowS
Show)

data BlockSpecification =
    BSArch  Name
  | BSBlock Label
  | BSGen   Label
  deriving (BlockSpecification -> BlockSpecification -> Bool
(BlockSpecification -> BlockSpecification -> Bool)
-> (BlockSpecification -> BlockSpecification -> Bool)
-> Eq BlockSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockSpecification -> BlockSpecification -> Bool
$c/= :: BlockSpecification -> BlockSpecification -> Bool
== :: BlockSpecification -> BlockSpecification -> Bool
$c== :: BlockSpecification -> BlockSpecification -> Bool
Eq, Int -> BlockSpecification -> ShowS
[BlockSpecification] -> ShowS
BlockSpecification -> String
(Int -> BlockSpecification -> ShowS)
-> (BlockSpecification -> String)
-> ([BlockSpecification] -> ShowS)
-> Show BlockSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockSpecification] -> ShowS
$cshowList :: [BlockSpecification] -> ShowS
show :: BlockSpecification -> String
$cshow :: BlockSpecification -> String
showsPrec :: Int -> BlockSpecification -> ShowS
$cshowsPrec :: Int -> BlockSpecification -> ShowS
Show)

data IndexSpecification =
    ISRange DiscreteRange
  | ISExp   Expression
  deriving (IndexSpecification -> IndexSpecification -> Bool
(IndexSpecification -> IndexSpecification -> Bool)
-> (IndexSpecification -> IndexSpecification -> Bool)
-> Eq IndexSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexSpecification -> IndexSpecification -> Bool
$c/= :: IndexSpecification -> IndexSpecification -> Bool
== :: IndexSpecification -> IndexSpecification -> Bool
$c== :: IndexSpecification -> IndexSpecification -> Bool
Eq, Int -> IndexSpecification -> ShowS
[IndexSpecification] -> ShowS
IndexSpecification -> String
(Int -> IndexSpecification -> ShowS)
-> (IndexSpecification -> String)
-> ([IndexSpecification] -> ShowS)
-> Show IndexSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexSpecification] -> ShowS
$cshowList :: [IndexSpecification] -> ShowS
show :: IndexSpecification -> String
$cshow :: IndexSpecification -> String
showsPrec :: Int -> IndexSpecification -> ShowS
$cshowsPrec :: Int -> IndexSpecification -> ShowS
Show)

data ConfigurationItem  =
    CIBlock BlockConfiguration
  | CIComp  ComponentConfiguration
  deriving (ConfigurationItem -> ConfigurationItem -> Bool
(ConfigurationItem -> ConfigurationItem -> Bool)
-> (ConfigurationItem -> ConfigurationItem -> Bool)
-> Eq ConfigurationItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationItem -> ConfigurationItem -> Bool
$c/= :: ConfigurationItem -> ConfigurationItem -> Bool
== :: ConfigurationItem -> ConfigurationItem -> Bool
$c== :: ConfigurationItem -> ConfigurationItem -> Bool
Eq, Int -> ConfigurationItem -> ShowS
[ConfigurationItem] -> ShowS
ConfigurationItem -> String
(Int -> ConfigurationItem -> ShowS)
-> (ConfigurationItem -> String)
-> ([ConfigurationItem] -> ShowS)
-> Show ConfigurationItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationItem] -> ShowS
$cshowList :: [ConfigurationItem] -> ShowS
show :: ConfigurationItem -> String
$cshow :: ConfigurationItem -> String
showsPrec :: Int -> ConfigurationItem -> ShowS
$cshowsPrec :: Int -> ConfigurationItem -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 1.3.2 Component configuration

{-
    component_configuration ::=
      FOR component_specification
        [ binding_indication ; ]
	[ block_configuration ]
      END FOR ;
-}

data ComponentConfiguration = ComponentConfiguration {
    ComponentConfiguration -> ComponentSpecification
comp_specification       :: ComponentSpecification
  , ComponentConfiguration -> Maybe BindingIndication
comp_binding_indication  :: Maybe BindingIndication
  , ComponentConfiguration -> Maybe BlockConfiguration
comp_block_configuration :: Maybe BlockConfiguration
  }
  deriving (ComponentConfiguration -> ComponentConfiguration -> Bool
(ComponentConfiguration -> ComponentConfiguration -> Bool)
-> (ComponentConfiguration -> ComponentConfiguration -> Bool)
-> Eq ComponentConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentConfiguration -> ComponentConfiguration -> Bool
$c/= :: ComponentConfiguration -> ComponentConfiguration -> Bool
== :: ComponentConfiguration -> ComponentConfiguration -> Bool
$c== :: ComponentConfiguration -> ComponentConfiguration -> Bool
Eq, Int -> ComponentConfiguration -> ShowS
[ComponentConfiguration] -> ShowS
ComponentConfiguration -> String
(Int -> ComponentConfiguration -> ShowS)
-> (ComponentConfiguration -> String)
-> ([ComponentConfiguration] -> ShowS)
-> Show ComponentConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentConfiguration] -> ShowS
$cshowList :: [ComponentConfiguration] -> ShowS
show :: ComponentConfiguration -> String
$cshow :: ComponentConfiguration -> String
showsPrec :: Int -> ComponentConfiguration -> ShowS
$cshowsPrec :: Int -> ComponentConfiguration -> ShowS
Show)

--------------------------------------------------------------------------------
--
--                                   -- 2 --
--
--                           Subprograms and packages
-- 
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- * 2.1 Subprogram declarations
--------------------------------------------------------------------------------
{-
    subprogram_declaration ::=
      subprogram_specification ;

    subprogram_specification ::=
      PROCEDURE designator [ ( formal_parameter_list ) ]
      | [ PURE | IMPURE ] FUNCTION designator [ ( formal_parameter_list ) ]
        RETURN type_mark

    designator ::= identifier | operator_symbol

    operator_symbol ::= string_literal
-}

newtype SubprogramDeclaration = SubprogramDeclaration SubprogramSpecification
  deriving (SubprogramDeclaration -> SubprogramDeclaration -> Bool
(SubprogramDeclaration -> SubprogramDeclaration -> Bool)
-> (SubprogramDeclaration -> SubprogramDeclaration -> Bool)
-> Eq SubprogramDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubprogramDeclaration -> SubprogramDeclaration -> Bool
$c/= :: SubprogramDeclaration -> SubprogramDeclaration -> Bool
== :: SubprogramDeclaration -> SubprogramDeclaration -> Bool
$c== :: SubprogramDeclaration -> SubprogramDeclaration -> Bool
Eq, Int -> SubprogramDeclaration -> ShowS
[SubprogramDeclaration] -> ShowS
SubprogramDeclaration -> String
(Int -> SubprogramDeclaration -> ShowS)
-> (SubprogramDeclaration -> String)
-> ([SubprogramDeclaration] -> ShowS)
-> Show SubprogramDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubprogramDeclaration] -> ShowS
$cshowList :: [SubprogramDeclaration] -> ShowS
show :: SubprogramDeclaration -> String
$cshow :: SubprogramDeclaration -> String
showsPrec :: Int -> SubprogramDeclaration -> ShowS
$cshowsPrec :: Int -> SubprogramDeclaration -> ShowS
Show)

data SubprogramSpecification =
    SubprogramProcedure {
      SubprogramSpecification -> Designator
subproc_designator            :: Designator
    , SubprogramSpecification -> Maybe FormalParameterList
subproc_formal_parameter_list :: Maybe FormalParameterList
    }
  | SubprogramFunction {
      SubprogramSpecification -> Maybe Bool
subfun_purity                 :: Maybe Bool
    , SubprogramSpecification -> Designator
subfun_designator             :: Designator
    , SubprogramSpecification -> Maybe FormalParameterList
subfun_formal_parameter_list  :: Maybe FormalParameterList
    , SubprogramSpecification -> TypeMark
subfun_type_mark              :: TypeMark
    }
  deriving (SubprogramSpecification -> SubprogramSpecification -> Bool
(SubprogramSpecification -> SubprogramSpecification -> Bool)
-> (SubprogramSpecification -> SubprogramSpecification -> Bool)
-> Eq SubprogramSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubprogramSpecification -> SubprogramSpecification -> Bool
$c/= :: SubprogramSpecification -> SubprogramSpecification -> Bool
== :: SubprogramSpecification -> SubprogramSpecification -> Bool
$c== :: SubprogramSpecification -> SubprogramSpecification -> Bool
Eq, Int -> SubprogramSpecification -> ShowS
[SubprogramSpecification] -> ShowS
SubprogramSpecification -> String
(Int -> SubprogramSpecification -> ShowS)
-> (SubprogramSpecification -> String)
-> ([SubprogramSpecification] -> ShowS)
-> Show SubprogramSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubprogramSpecification] -> ShowS
$cshowList :: [SubprogramSpecification] -> ShowS
show :: SubprogramSpecification -> String
$cshow :: SubprogramSpecification -> String
showsPrec :: Int -> SubprogramSpecification -> ShowS
$cshowsPrec :: Int -> SubprogramSpecification -> ShowS
Show)

data Designator =
    DId Identifier
  | DOp OperatorSymbol
  deriving (Designator -> Designator -> Bool
(Designator -> Designator -> Bool)
-> (Designator -> Designator -> Bool) -> Eq Designator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Designator -> Designator -> Bool
$c/= :: Designator -> Designator -> Bool
== :: Designator -> Designator -> Bool
$c== :: Designator -> Designator -> Bool
Eq, Int -> Designator -> ShowS
[Designator] -> ShowS
Designator -> String
(Int -> Designator -> ShowS)
-> (Designator -> String)
-> ([Designator] -> ShowS)
-> Show Designator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Designator] -> ShowS
$cshowList :: [Designator] -> ShowS
show :: Designator -> String
$cshow :: Designator -> String
showsPrec :: Int -> Designator -> ShowS
$cshowsPrec :: Int -> Designator -> ShowS
Show)

type OperatorSymbol = StringLiteral

--------------------------------------------------------------------------------
-- ** 2.1.1 Formal parameters
{-
    formal_parameter_list ::= parameter_interface_list
-}

type FormalParameterList = InterfaceList

--------------------------------------------------------------------------------
-- *** 2.1.1.1 Constant and variable parameters

-- properties ... todo

--------------------------------------------------------------------------------
-- *** 2.1.1.2 Signal parameter

-- properties ... todo

--------------------------------------------------------------------------------
-- *** 2.1.1.3 File parameter

-- properties ... todo

--------------------------------------------------------------------------------
-- * 2.2 Subprogram bodies
--------------------------------------------------------------------------------
{-
    subprogram_body ::=
      subprogram_specification IS
        subprogram_declarative_part
      BEGIN
	subprogram_statement_part
      END [ subprogram_kind ] [ designator ] ;

    subprogram_declarative_part ::=
      { subprogram_declarative_item }

    subprogram_declarative_item ::=
        subprogram_declaration
      | subprogram_body
      | type_declaration
      | subtype_declaration
      | constant_declaration
      | variable_declaration
      | file_declaration
      | alias_declaration
      | attribute_declaration
      | attribute_specification
      | use_clause
      | group_template_declaration
      | group_declaration


    subprogram_statement_part ::=
      { sequential_statement }

    subprogram_kind ::= PROCEDURE | FUNCTION
-}

data SubprogramBody = SubprogramBody {
    SubprogramBody -> SubprogramSpecification
subprog_specification    :: SubprogramSpecification
  , SubprogramBody -> SubprogramDeclarativePart
subprog_declarative_part :: SubprogramDeclarativePart
  , SubprogramBody -> SubprogramStatementPart
subprog_statement_part   :: SubprogramStatementPart
  , SubprogramBody -> Maybe SubprogramKind
subprog_kind             :: Maybe SubprogramKind
  , SubprogramBody -> Maybe Designator
subprog_designator       :: Maybe Designator
  }
  deriving (SubprogramBody -> SubprogramBody -> Bool
(SubprogramBody -> SubprogramBody -> Bool)
-> (SubprogramBody -> SubprogramBody -> Bool) -> Eq SubprogramBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubprogramBody -> SubprogramBody -> Bool
$c/= :: SubprogramBody -> SubprogramBody -> Bool
== :: SubprogramBody -> SubprogramBody -> Bool
$c== :: SubprogramBody -> SubprogramBody -> Bool
Eq, Int -> SubprogramBody -> ShowS
[SubprogramBody] -> ShowS
SubprogramBody -> String
(Int -> SubprogramBody -> ShowS)
-> (SubprogramBody -> String)
-> ([SubprogramBody] -> ShowS)
-> Show SubprogramBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubprogramBody] -> ShowS
$cshowList :: [SubprogramBody] -> ShowS
show :: SubprogramBody -> String
$cshow :: SubprogramBody -> String
showsPrec :: Int -> SubprogramBody -> ShowS
$cshowsPrec :: Int -> SubprogramBody -> ShowS
Show)

type SubprogramDeclarativePart = [SubprogramDeclarativeItem]

data SubprogramDeclarativeItem =
    SDISubprogDecl  SubprogramDeclaration
  | SDISubprogBody  SubprogramBody
  | SDIType         TypeDeclaration
  | SDISubtype      SubtypeDeclaration
  | SDIConstant     ConstantDeclaration
  | SDIVariable     VariableDeclaration
  | SDIFile         FileDeclaration
  | SDIAlias        AliasDeclaration
  | SDIAttrDecl     AttributeDeclaration
  | SDIAttrSepc     AttributeSpecification
  | SDIUseClause    UseClause
  | SDIGroupTemp    GroupTemplateDeclaration
  | SDIGroup        GroupDeclaration
  deriving (SubprogramDeclarativeItem -> SubprogramDeclarativeItem -> Bool
(SubprogramDeclarativeItem -> SubprogramDeclarativeItem -> Bool)
-> (SubprogramDeclarativeItem -> SubprogramDeclarativeItem -> Bool)
-> Eq SubprogramDeclarativeItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubprogramDeclarativeItem -> SubprogramDeclarativeItem -> Bool
$c/= :: SubprogramDeclarativeItem -> SubprogramDeclarativeItem -> Bool
== :: SubprogramDeclarativeItem -> SubprogramDeclarativeItem -> Bool
$c== :: SubprogramDeclarativeItem -> SubprogramDeclarativeItem -> Bool
Eq, Int -> SubprogramDeclarativeItem -> ShowS
SubprogramDeclarativePart -> ShowS
SubprogramDeclarativeItem -> String
(Int -> SubprogramDeclarativeItem -> ShowS)
-> (SubprogramDeclarativeItem -> String)
-> (SubprogramDeclarativePart -> ShowS)
-> Show SubprogramDeclarativeItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: SubprogramDeclarativePart -> ShowS
$cshowList :: SubprogramDeclarativePart -> ShowS
show :: SubprogramDeclarativeItem -> String
$cshow :: SubprogramDeclarativeItem -> String
showsPrec :: Int -> SubprogramDeclarativeItem -> ShowS
$cshowsPrec :: Int -> SubprogramDeclarativeItem -> ShowS
Show)
    
type SubprogramStatementPart   = [SequentialStatement]

data SubprogramKind            = Procedure | Function
  deriving (SubprogramKind -> SubprogramKind -> Bool
(SubprogramKind -> SubprogramKind -> Bool)
-> (SubprogramKind -> SubprogramKind -> Bool) -> Eq SubprogramKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubprogramKind -> SubprogramKind -> Bool
$c/= :: SubprogramKind -> SubprogramKind -> Bool
== :: SubprogramKind -> SubprogramKind -> Bool
$c== :: SubprogramKind -> SubprogramKind -> Bool
Eq, Int -> SubprogramKind -> ShowS
[SubprogramKind] -> ShowS
SubprogramKind -> String
(Int -> SubprogramKind -> ShowS)
-> (SubprogramKind -> String)
-> ([SubprogramKind] -> ShowS)
-> Show SubprogramKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubprogramKind] -> ShowS
$cshowList :: [SubprogramKind] -> ShowS
show :: SubprogramKind -> String
$cshow :: SubprogramKind -> String
showsPrec :: Int -> SubprogramKind -> ShowS
$cshowsPrec :: Int -> SubprogramKind -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 2.3 Subprogram overloading

-- properties ... todo

--------------------------------------------------------------------------------
-- ** 2.3.1 Operator overloading

-- properties ... todo

--------------------------------------------------------------------------------
-- ** 2.3.2 Signatures
{-
    signature ::= [ [ type_mark { , type_mark } ] [ RETURN type_mark ] ]
-}

data Signature = Signature (Maybe (Maybe [TypeMark], Maybe TypeMark))
  deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 2.4 Resolution functions

-- properties ... todo

--------------------------------------------------------------------------------
-- * 2.5 Package declarations
{- 
    package_declaration ::=
      PACKAGE identifier IS
        package_declarative_part
      END [ PACKAGE ] [ package_simple_name ] ;

    package_declarative_part ::=
      { package_declarative_item }

    package_declarative_item ::=
        subprogram_declaration
      | type_declaration
      | subtype_declaration
      | constant_declaration
      | signal_declaration
      | shared_variable_declaration
      | file_declaration
      | alias_declaration
      | component_declaration
      | attribute_declaration
      | attribute_specification
      | disconnection_specification
      | use_clause
      | group_template_declaration
      | group_declaration
-}

data PackageDeclaration = PackageDeclaration {
    PackageDeclaration -> Identifier
packd_identifier       :: Identifier
  , PackageDeclaration -> PackageDeclarativePart
packd_declarative_part :: PackageDeclarativePart
  }
  deriving (PackageDeclaration -> PackageDeclaration -> Bool
(PackageDeclaration -> PackageDeclaration -> Bool)
-> (PackageDeclaration -> PackageDeclaration -> Bool)
-> Eq PackageDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageDeclaration -> PackageDeclaration -> Bool
$c/= :: PackageDeclaration -> PackageDeclaration -> Bool
== :: PackageDeclaration -> PackageDeclaration -> Bool
$c== :: PackageDeclaration -> PackageDeclaration -> Bool
Eq, Int -> PackageDeclaration -> ShowS
[PackageDeclaration] -> ShowS
PackageDeclaration -> String
(Int -> PackageDeclaration -> ShowS)
-> (PackageDeclaration -> String)
-> ([PackageDeclaration] -> ShowS)
-> Show PackageDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageDeclaration] -> ShowS
$cshowList :: [PackageDeclaration] -> ShowS
show :: PackageDeclaration -> String
$cshow :: PackageDeclaration -> String
showsPrec :: Int -> PackageDeclaration -> ShowS
$cshowsPrec :: Int -> PackageDeclaration -> ShowS
Show)

type PackageDeclarativePart = [PackageDeclarativeItem]

data PackageDeclarativeItem =
    PHDISubprogDecl  SubprogramDeclaration
  | PHDISubprogBody  SubprogramBody
  | PHDIType         TypeDeclaration
  | PHDISubtype      SubtypeDeclaration
  | PHDIConstant     ConstantDeclaration
  | PHDISignal       SignalDeclaration
  | PHDIShared       VariableDeclaration
  | PHDIFile         FileDeclaration
  | PHDIAlias        AliasDeclaration
  | PHDIComp         ComponentDeclaration
  | PHDIAttrDecl     AttributeDeclaration
  | PHDIAttrSpec     AttributeSpecification
  | PHDIDiscSpec     DisconnectionSpecification
  | PHDIUseClause    UseClause
  | PHDIGroupTemp    GroupTemplateDeclaration
  | PHDIGroup        GroupDeclaration
  deriving (PackageDeclarativeItem -> PackageDeclarativeItem -> Bool
(PackageDeclarativeItem -> PackageDeclarativeItem -> Bool)
-> (PackageDeclarativeItem -> PackageDeclarativeItem -> Bool)
-> Eq PackageDeclarativeItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageDeclarativeItem -> PackageDeclarativeItem -> Bool
$c/= :: PackageDeclarativeItem -> PackageDeclarativeItem -> Bool
== :: PackageDeclarativeItem -> PackageDeclarativeItem -> Bool
$c== :: PackageDeclarativeItem -> PackageDeclarativeItem -> Bool
Eq, Int -> PackageDeclarativeItem -> ShowS
PackageDeclarativePart -> ShowS
PackageDeclarativeItem -> String
(Int -> PackageDeclarativeItem -> ShowS)
-> (PackageDeclarativeItem -> String)
-> (PackageDeclarativePart -> ShowS)
-> Show PackageDeclarativeItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: PackageDeclarativePart -> ShowS
$cshowList :: PackageDeclarativePart -> ShowS
show :: PackageDeclarativeItem -> String
$cshow :: PackageDeclarativeItem -> String
showsPrec :: Int -> PackageDeclarativeItem -> ShowS
$cshowsPrec :: Int -> PackageDeclarativeItem -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 2.6 Package bodies
{-
    package_body ::=
      PACKAGE BODY package_simple_name IS
        package_body_declarative_part
      END [ PACKAGE BODY ] [ package_simple_name ] ;

    package_body_declarative_part ::=
      { package_body_declarative_item }

    package_body_declarative_item ::=
        subprogram_declaration
      | subprogram_body
      | type_declaration
      | subtype_declaration
      | constant_declaration
      | shared_variable_declaration
      | file_declaration
      | alias_declaration
      | use_clause
      | group_template_declaration
      | group_declaration
-}

data PackageBody = PackageBody {
    PackageBody -> Identifier
packb_simple_name           :: SimpleName
  , PackageBody -> PackageBodyDeclarativePart
packb_body_declarative_part :: PackageBodyDeclarativePart
  }
  deriving (PackageBody -> PackageBody -> Bool
(PackageBody -> PackageBody -> Bool)
-> (PackageBody -> PackageBody -> Bool) -> Eq PackageBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageBody -> PackageBody -> Bool
$c/= :: PackageBody -> PackageBody -> Bool
== :: PackageBody -> PackageBody -> Bool
$c== :: PackageBody -> PackageBody -> Bool
Eq, Int -> PackageBody -> ShowS
[PackageBody] -> ShowS
PackageBody -> String
(Int -> PackageBody -> ShowS)
-> (PackageBody -> String)
-> ([PackageBody] -> ShowS)
-> Show PackageBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageBody] -> ShowS
$cshowList :: [PackageBody] -> ShowS
show :: PackageBody -> String
$cshow :: PackageBody -> String
showsPrec :: Int -> PackageBody -> ShowS
$cshowsPrec :: Int -> PackageBody -> ShowS
Show)

type PackageBodyDeclarativePart = [PackageBodyDeclarativeItem]

data PackageBodyDeclarativeItem = 
    PBDISubprogDecl  SubprogramDeclaration
  | PBDISubprogBody  SubprogramBody
  | PBDIType         TypeDeclaration
  | PBDISubtype      SubtypeDeclaration
  | PBDIConstant     ConstantDeclaration
  | PBDIShared       VariableDeclaration
  | PBDIFile         FileDeclaration
  | PBDIAlias        AliasDeclaration
  | PBDIUseClause    UseClause
  | PBDIGroupTemp    GroupTemplateDeclaration
  | PBDIGroup        GroupDeclaration
  deriving (PackageBodyDeclarativeItem -> PackageBodyDeclarativeItem -> Bool
(PackageBodyDeclarativeItem -> PackageBodyDeclarativeItem -> Bool)
-> (PackageBodyDeclarativeItem
    -> PackageBodyDeclarativeItem -> Bool)
-> Eq PackageBodyDeclarativeItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageBodyDeclarativeItem -> PackageBodyDeclarativeItem -> Bool
$c/= :: PackageBodyDeclarativeItem -> PackageBodyDeclarativeItem -> Bool
== :: PackageBodyDeclarativeItem -> PackageBodyDeclarativeItem -> Bool
$c== :: PackageBodyDeclarativeItem -> PackageBodyDeclarativeItem -> Bool
Eq, Int -> PackageBodyDeclarativeItem -> ShowS
PackageBodyDeclarativePart -> ShowS
PackageBodyDeclarativeItem -> String
(Int -> PackageBodyDeclarativeItem -> ShowS)
-> (PackageBodyDeclarativeItem -> String)
-> (PackageBodyDeclarativePart -> ShowS)
-> Show PackageBodyDeclarativeItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: PackageBodyDeclarativePart -> ShowS
$cshowList :: PackageBodyDeclarativePart -> ShowS
show :: PackageBodyDeclarativeItem -> String
$cshow :: PackageBodyDeclarativeItem -> String
showsPrec :: Int -> PackageBodyDeclarativeItem -> ShowS
$cshowsPrec :: Int -> PackageBodyDeclarativeItem -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 2.7 Conformance rules

-- properties ... todo


--------------------------------------------------------------------------------
--
--                                   -- 3 --
--
--                                    Types
-- 
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- * 3.1 Scalar types
{-
    scalar_type_definition ::=
	enumeration_type_definition
      | integer_type_definition
      | floating_type_definition
      | physical_type_definition

    range_constraint ::= RANGE range

    range ::=
        range_attribute_name
      | simple_expression direction simple_expression

    direction ::= TO | DOWNTO
-}

data ScalarTypeDefinition =
    ScalarEnum  EnumerationTypeDefinition
  | ScalarInt   IntegerTypeDefinition
  | ScalarFloat FloatingTypeDefinition
  | ScalarPhys  PhysicalTypeDefinition
  deriving (ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
(ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> (ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> Eq ScalarTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
$c/= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
== :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
$c== :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
Eq, Int -> ScalarTypeDefinition -> ShowS
[ScalarTypeDefinition] -> ShowS
ScalarTypeDefinition -> String
(Int -> ScalarTypeDefinition -> ShowS)
-> (ScalarTypeDefinition -> String)
-> ([ScalarTypeDefinition] -> ShowS)
-> Show ScalarTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScalarTypeDefinition] -> ShowS
$cshowList :: [ScalarTypeDefinition] -> ShowS
show :: ScalarTypeDefinition -> String
$cshow :: ScalarTypeDefinition -> String
showsPrec :: Int -> ScalarTypeDefinition -> ShowS
$cshowsPrec :: Int -> ScalarTypeDefinition -> ShowS
Show)

data RangeConstraint = RangeConstraint Range
  deriving (RangeConstraint -> RangeConstraint -> Bool
(RangeConstraint -> RangeConstraint -> Bool)
-> (RangeConstraint -> RangeConstraint -> Bool)
-> Eq RangeConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RangeConstraint -> RangeConstraint -> Bool
$c/= :: RangeConstraint -> RangeConstraint -> Bool
== :: RangeConstraint -> RangeConstraint -> Bool
$c== :: RangeConstraint -> RangeConstraint -> Bool
Eq, Int -> RangeConstraint -> ShowS
[RangeConstraint] -> ShowS
RangeConstraint -> String
(Int -> RangeConstraint -> ShowS)
-> (RangeConstraint -> String)
-> ([RangeConstraint] -> ShowS)
-> Show RangeConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RangeConstraint] -> ShowS
$cshowList :: [RangeConstraint] -> ShowS
show :: RangeConstraint -> String
$cshow :: RangeConstraint -> String
showsPrec :: Int -> RangeConstraint -> ShowS
$cshowsPrec :: Int -> RangeConstraint -> ShowS
Show)

data Range =
    RAttr   AttributeName
  | RSimple {
      Range -> SimpleExpression
range_lower :: SimpleExpression
    , Range -> Direction
range_dir   :: Direction
    , Range -> SimpleExpression
range_upper :: SimpleExpression
    }
  deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq, Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Int -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> String
$cshow :: Range -> String
showsPrec :: Int -> Range -> ShowS
$cshowsPrec :: Int -> Range -> ShowS
Show)

data Direction = To | DownTo
  deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 3.1.1 Enumeration types
{-
    enumeration_type_definition ::=
      ( enumeration_literal { , enumeration_literal } )

    enumeration_literal ::= identifier | character_literal
-}

data EnumerationTypeDefinition = EnumerationTypeDefinition [EnumerationLiteral]
  deriving (EnumerationTypeDefinition -> EnumerationTypeDefinition -> Bool
(EnumerationTypeDefinition -> EnumerationTypeDefinition -> Bool)
-> (EnumerationTypeDefinition -> EnumerationTypeDefinition -> Bool)
-> Eq EnumerationTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumerationTypeDefinition -> EnumerationTypeDefinition -> Bool
$c/= :: EnumerationTypeDefinition -> EnumerationTypeDefinition -> Bool
== :: EnumerationTypeDefinition -> EnumerationTypeDefinition -> Bool
$c== :: EnumerationTypeDefinition -> EnumerationTypeDefinition -> Bool
Eq, Int -> EnumerationTypeDefinition -> ShowS
[EnumerationTypeDefinition] -> ShowS
EnumerationTypeDefinition -> String
(Int -> EnumerationTypeDefinition -> ShowS)
-> (EnumerationTypeDefinition -> String)
-> ([EnumerationTypeDefinition] -> ShowS)
-> Show EnumerationTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumerationTypeDefinition] -> ShowS
$cshowList :: [EnumerationTypeDefinition] -> ShowS
show :: EnumerationTypeDefinition -> String
$cshow :: EnumerationTypeDefinition -> String
showsPrec :: Int -> EnumerationTypeDefinition -> ShowS
$cshowsPrec :: Int -> EnumerationTypeDefinition -> ShowS
Show)

data EnumerationLiteral =
    EId   Identifier
  | EChar CharacterLiteral
  deriving (EnumerationLiteral -> EnumerationLiteral -> Bool
(EnumerationLiteral -> EnumerationLiteral -> Bool)
-> (EnumerationLiteral -> EnumerationLiteral -> Bool)
-> Eq EnumerationLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumerationLiteral -> EnumerationLiteral -> Bool
$c/= :: EnumerationLiteral -> EnumerationLiteral -> Bool
== :: EnumerationLiteral -> EnumerationLiteral -> Bool
$c== :: EnumerationLiteral -> EnumerationLiteral -> Bool
Eq, Int -> EnumerationLiteral -> ShowS
[EnumerationLiteral] -> ShowS
EnumerationLiteral -> String
(Int -> EnumerationLiteral -> ShowS)
-> (EnumerationLiteral -> String)
-> ([EnumerationLiteral] -> ShowS)
-> Show EnumerationLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumerationLiteral] -> ShowS
$cshowList :: [EnumerationLiteral] -> ShowS
show :: EnumerationLiteral -> String
$cshow :: EnumerationLiteral -> String
showsPrec :: Int -> EnumerationLiteral -> ShowS
$cshowsPrec :: Int -> EnumerationLiteral -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 3.1.1.1 Predefined enumeration types

-- predefined ... todo

--------------------------------------------------------------------------------
-- ** 3.1.2 Integer types
{-
    integer_type_definition ::= range_constraint
-}

type IntegerTypeDefinition = RangeConstraint

--------------------------------------------------------------------------------
-- *** 3.1.2.1 Predefined integer types

-- predefined ... todo

--------------------------------------------------------------------------------
-- ** 3.1.3 Physical types
{-
    physical_type_definition ::=
      range_constraint
        UNITS
	  primary_unit_declaration
	  { secondary_unit_declaration }
	END UNITS [ physical_type_simple_name ]

    primary_unit_declaration ::= identifier ;

    secondary_unit_declaration ::= identifier = physical_literal ;

    physical_literal ::= [ abstract_literal ] unit_name
-}

data PhysicalTypeDefinition = PhysicalTypeDefinition {
    PhysicalTypeDefinition -> RangeConstraint
physd_range_constraint           :: RangeConstraint
  , PhysicalTypeDefinition -> Identifier
physd_primary_unit_declaration   :: PrimaryUnitDeclaration
  , PhysicalTypeDefinition -> [SecondaryUnitDeclaration]
physd_secondary_unit_declaration :: [SecondaryUnitDeclaration]
  , PhysicalTypeDefinition -> Maybe Identifier
physd_simple_name                :: Maybe SimpleName
  }
  deriving (PhysicalTypeDefinition -> PhysicalTypeDefinition -> Bool
(PhysicalTypeDefinition -> PhysicalTypeDefinition -> Bool)
-> (PhysicalTypeDefinition -> PhysicalTypeDefinition -> Bool)
-> Eq PhysicalTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalTypeDefinition -> PhysicalTypeDefinition -> Bool
$c/= :: PhysicalTypeDefinition -> PhysicalTypeDefinition -> Bool
== :: PhysicalTypeDefinition -> PhysicalTypeDefinition -> Bool
$c== :: PhysicalTypeDefinition -> PhysicalTypeDefinition -> Bool
Eq, Int -> PhysicalTypeDefinition -> ShowS
[PhysicalTypeDefinition] -> ShowS
PhysicalTypeDefinition -> String
(Int -> PhysicalTypeDefinition -> ShowS)
-> (PhysicalTypeDefinition -> String)
-> ([PhysicalTypeDefinition] -> ShowS)
-> Show PhysicalTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PhysicalTypeDefinition] -> ShowS
$cshowList :: [PhysicalTypeDefinition] -> ShowS
show :: PhysicalTypeDefinition -> String
$cshow :: PhysicalTypeDefinition -> String
showsPrec :: Int -> PhysicalTypeDefinition -> ShowS
$cshowsPrec :: Int -> PhysicalTypeDefinition -> ShowS
Show)

type PrimaryUnitDeclaration   = Identifier

data SecondaryUnitDeclaration = SecondaryUnitDeclaration Identifier PhysicalLiteral
  deriving (SecondaryUnitDeclaration -> SecondaryUnitDeclaration -> Bool
(SecondaryUnitDeclaration -> SecondaryUnitDeclaration -> Bool)
-> (SecondaryUnitDeclaration -> SecondaryUnitDeclaration -> Bool)
-> Eq SecondaryUnitDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecondaryUnitDeclaration -> SecondaryUnitDeclaration -> Bool
$c/= :: SecondaryUnitDeclaration -> SecondaryUnitDeclaration -> Bool
== :: SecondaryUnitDeclaration -> SecondaryUnitDeclaration -> Bool
$c== :: SecondaryUnitDeclaration -> SecondaryUnitDeclaration -> Bool
Eq, Int -> SecondaryUnitDeclaration -> ShowS
[SecondaryUnitDeclaration] -> ShowS
SecondaryUnitDeclaration -> String
(Int -> SecondaryUnitDeclaration -> ShowS)
-> (SecondaryUnitDeclaration -> String)
-> ([SecondaryUnitDeclaration] -> ShowS)
-> Show SecondaryUnitDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecondaryUnitDeclaration] -> ShowS
$cshowList :: [SecondaryUnitDeclaration] -> ShowS
show :: SecondaryUnitDeclaration -> String
$cshow :: SecondaryUnitDeclaration -> String
showsPrec :: Int -> SecondaryUnitDeclaration -> ShowS
$cshowsPrec :: Int -> SecondaryUnitDeclaration -> ShowS
Show)

data PhysicalLiteral = PhysicalLiteral {
    PhysicalLiteral -> Maybe Literal
physl_abstract_literal :: Maybe Literal
  , PhysicalLiteral -> Name
physl_unit_name        :: Name
  }
  deriving (PhysicalLiteral -> PhysicalLiteral -> Bool
(PhysicalLiteral -> PhysicalLiteral -> Bool)
-> (PhysicalLiteral -> PhysicalLiteral -> Bool)
-> Eq PhysicalLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalLiteral -> PhysicalLiteral -> Bool
$c/= :: PhysicalLiteral -> PhysicalLiteral -> Bool
== :: PhysicalLiteral -> PhysicalLiteral -> Bool
$c== :: PhysicalLiteral -> PhysicalLiteral -> Bool
Eq, Int -> PhysicalLiteral -> ShowS
[PhysicalLiteral] -> ShowS
PhysicalLiteral -> String
(Int -> PhysicalLiteral -> ShowS)
-> (PhysicalLiteral -> String)
-> ([PhysicalLiteral] -> ShowS)
-> Show PhysicalLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PhysicalLiteral] -> ShowS
$cshowList :: [PhysicalLiteral] -> ShowS
show :: PhysicalLiteral -> String
$cshow :: PhysicalLiteral -> String
showsPrec :: Int -> PhysicalLiteral -> ShowS
$cshowsPrec :: Int -> PhysicalLiteral -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 3.1.3.1 Predefined physical types

-- predefined ... todo

--------------------------------------------------------------------------------
-- ** 3.1.4 Floating point types
{-
    floating_type_definition ::= range_constraint
-}

type FloatingTypeDefinition = RangeConstraint

--------------------------------------------------------------------------------
-- *** 3.1.4.1 Predefined floating point types

-- predefined ... todo

--------------------------------------------------------------------------------
-- * 3.2 Composite types
{-
    composite_type_definition ::=
        array_type_definition
      | record_type_definition
-}

data CompositeTypeDefinition =
    CTDArray  ArrayTypeDefinition
  | CTDRecord RecordTypeDefinition
  deriving (CompositeTypeDefinition -> CompositeTypeDefinition -> Bool
(CompositeTypeDefinition -> CompositeTypeDefinition -> Bool)
-> (CompositeTypeDefinition -> CompositeTypeDefinition -> Bool)
-> Eq CompositeTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompositeTypeDefinition -> CompositeTypeDefinition -> Bool
$c/= :: CompositeTypeDefinition -> CompositeTypeDefinition -> Bool
== :: CompositeTypeDefinition -> CompositeTypeDefinition -> Bool
$c== :: CompositeTypeDefinition -> CompositeTypeDefinition -> Bool
Eq, Int -> CompositeTypeDefinition -> ShowS
[CompositeTypeDefinition] -> ShowS
CompositeTypeDefinition -> String
(Int -> CompositeTypeDefinition -> ShowS)
-> (CompositeTypeDefinition -> String)
-> ([CompositeTypeDefinition] -> ShowS)
-> Show CompositeTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompositeTypeDefinition] -> ShowS
$cshowList :: [CompositeTypeDefinition] -> ShowS
show :: CompositeTypeDefinition -> String
$cshow :: CompositeTypeDefinition -> String
showsPrec :: Int -> CompositeTypeDefinition -> ShowS
$cshowsPrec :: Int -> CompositeTypeDefinition -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 3.2.1 Array types
{-
    array_type_definition ::=
	unconstrained_array_definition
      | constrained_array_definition

    unconstrained_array_definition ::=
      ARRAY ( index_subtype_definition { , index_subtype_definition } )
        OF element_subtype_indication

    constrained_array_definition ::=
      ARRAY index_constraint OF element_subtype_indication

    index_subtype_definition ::= type_mark RANGE <>

    index_constraint ::= ( discrete_range { , discrete_range } )

    discrete_range ::= discrete_subtype_indication | range
-}

data ArrayTypeDefinition =
    ArrU UnconstrainedArrayDefinition
  | ArrC ConstrainedArrayDefinition
  deriving (ArrayTypeDefinition -> ArrayTypeDefinition -> Bool
(ArrayTypeDefinition -> ArrayTypeDefinition -> Bool)
-> (ArrayTypeDefinition -> ArrayTypeDefinition -> Bool)
-> Eq ArrayTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrayTypeDefinition -> ArrayTypeDefinition -> Bool
$c/= :: ArrayTypeDefinition -> ArrayTypeDefinition -> Bool
== :: ArrayTypeDefinition -> ArrayTypeDefinition -> Bool
$c== :: ArrayTypeDefinition -> ArrayTypeDefinition -> Bool
Eq, Int -> ArrayTypeDefinition -> ShowS
[ArrayTypeDefinition] -> ShowS
ArrayTypeDefinition -> String
(Int -> ArrayTypeDefinition -> ShowS)
-> (ArrayTypeDefinition -> String)
-> ([ArrayTypeDefinition] -> ShowS)
-> Show ArrayTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrayTypeDefinition] -> ShowS
$cshowList :: [ArrayTypeDefinition] -> ShowS
show :: ArrayTypeDefinition -> String
$cshow :: ArrayTypeDefinition -> String
showsPrec :: Int -> ArrayTypeDefinition -> ShowS
$cshowsPrec :: Int -> ArrayTypeDefinition -> ShowS
Show)

data UnconstrainedArrayDefinition = UnconstrainedArrayDefinition {
    UnconstrainedArrayDefinition -> [IndexSubtypeDefinition]
arru_index_subtype_definition   :: [IndexSubtypeDefinition]
  , UnconstrainedArrayDefinition -> SubtypeIndication
arru_element_subtype_indication :: SubtypeIndication
  }
  deriving (UnconstrainedArrayDefinition
-> UnconstrainedArrayDefinition -> Bool
(UnconstrainedArrayDefinition
 -> UnconstrainedArrayDefinition -> Bool)
-> (UnconstrainedArrayDefinition
    -> UnconstrainedArrayDefinition -> Bool)
-> Eq UnconstrainedArrayDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnconstrainedArrayDefinition
-> UnconstrainedArrayDefinition -> Bool
$c/= :: UnconstrainedArrayDefinition
-> UnconstrainedArrayDefinition -> Bool
== :: UnconstrainedArrayDefinition
-> UnconstrainedArrayDefinition -> Bool
$c== :: UnconstrainedArrayDefinition
-> UnconstrainedArrayDefinition -> Bool
Eq, Int -> UnconstrainedArrayDefinition -> ShowS
[UnconstrainedArrayDefinition] -> ShowS
UnconstrainedArrayDefinition -> String
(Int -> UnconstrainedArrayDefinition -> ShowS)
-> (UnconstrainedArrayDefinition -> String)
-> ([UnconstrainedArrayDefinition] -> ShowS)
-> Show UnconstrainedArrayDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnconstrainedArrayDefinition] -> ShowS
$cshowList :: [UnconstrainedArrayDefinition] -> ShowS
show :: UnconstrainedArrayDefinition -> String
$cshow :: UnconstrainedArrayDefinition -> String
showsPrec :: Int -> UnconstrainedArrayDefinition -> ShowS
$cshowsPrec :: Int -> UnconstrainedArrayDefinition -> ShowS
Show)

data ConstrainedArrayDefinition = ConstrainedArrayDefinition {
    ConstrainedArrayDefinition -> IndexConstraint
arrc_index_constraint   :: IndexConstraint
  , ConstrainedArrayDefinition -> SubtypeIndication
arrc_subtype_indication :: SubtypeIndication
  }
  deriving (ConstrainedArrayDefinition -> ConstrainedArrayDefinition -> Bool
(ConstrainedArrayDefinition -> ConstrainedArrayDefinition -> Bool)
-> (ConstrainedArrayDefinition
    -> ConstrainedArrayDefinition -> Bool)
-> Eq ConstrainedArrayDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstrainedArrayDefinition -> ConstrainedArrayDefinition -> Bool
$c/= :: ConstrainedArrayDefinition -> ConstrainedArrayDefinition -> Bool
== :: ConstrainedArrayDefinition -> ConstrainedArrayDefinition -> Bool
$c== :: ConstrainedArrayDefinition -> ConstrainedArrayDefinition -> Bool
Eq, Int -> ConstrainedArrayDefinition -> ShowS
[ConstrainedArrayDefinition] -> ShowS
ConstrainedArrayDefinition -> String
(Int -> ConstrainedArrayDefinition -> ShowS)
-> (ConstrainedArrayDefinition -> String)
-> ([ConstrainedArrayDefinition] -> ShowS)
-> Show ConstrainedArrayDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstrainedArrayDefinition] -> ShowS
$cshowList :: [ConstrainedArrayDefinition] -> ShowS
show :: ConstrainedArrayDefinition -> String
$cshow :: ConstrainedArrayDefinition -> String
showsPrec :: Int -> ConstrainedArrayDefinition -> ShowS
$cshowsPrec :: Int -> ConstrainedArrayDefinition -> ShowS
Show)

data IndexSubtypeDefinition = IndexSubtypeDefinition TypeMark
  deriving (IndexSubtypeDefinition -> IndexSubtypeDefinition -> Bool
(IndexSubtypeDefinition -> IndexSubtypeDefinition -> Bool)
-> (IndexSubtypeDefinition -> IndexSubtypeDefinition -> Bool)
-> Eq IndexSubtypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexSubtypeDefinition -> IndexSubtypeDefinition -> Bool
$c/= :: IndexSubtypeDefinition -> IndexSubtypeDefinition -> Bool
== :: IndexSubtypeDefinition -> IndexSubtypeDefinition -> Bool
$c== :: IndexSubtypeDefinition -> IndexSubtypeDefinition -> Bool
Eq, Int -> IndexSubtypeDefinition -> ShowS
[IndexSubtypeDefinition] -> ShowS
IndexSubtypeDefinition -> String
(Int -> IndexSubtypeDefinition -> ShowS)
-> (IndexSubtypeDefinition -> String)
-> ([IndexSubtypeDefinition] -> ShowS)
-> Show IndexSubtypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexSubtypeDefinition] -> ShowS
$cshowList :: [IndexSubtypeDefinition] -> ShowS
show :: IndexSubtypeDefinition -> String
$cshow :: IndexSubtypeDefinition -> String
showsPrec :: Int -> IndexSubtypeDefinition -> ShowS
$cshowsPrec :: Int -> IndexSubtypeDefinition -> ShowS
Show)

data IndexConstraint = IndexConstraint [DiscreteRange]
  deriving (IndexConstraint -> IndexConstraint -> Bool
(IndexConstraint -> IndexConstraint -> Bool)
-> (IndexConstraint -> IndexConstraint -> Bool)
-> Eq IndexConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexConstraint -> IndexConstraint -> Bool
$c/= :: IndexConstraint -> IndexConstraint -> Bool
== :: IndexConstraint -> IndexConstraint -> Bool
$c== :: IndexConstraint -> IndexConstraint -> Bool
Eq, Int -> IndexConstraint -> ShowS
[IndexConstraint] -> ShowS
IndexConstraint -> String
(Int -> IndexConstraint -> ShowS)
-> (IndexConstraint -> String)
-> ([IndexConstraint] -> ShowS)
-> Show IndexConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexConstraint] -> ShowS
$cshowList :: [IndexConstraint] -> ShowS
show :: IndexConstraint -> String
$cshow :: IndexConstraint -> String
showsPrec :: Int -> IndexConstraint -> ShowS
$cshowsPrec :: Int -> IndexConstraint -> ShowS
Show)

data DiscreteRange =
    DRSub   SubtypeIndication
  | DRRange Range
  deriving (DiscreteRange -> DiscreteRange -> Bool
(DiscreteRange -> DiscreteRange -> Bool)
-> (DiscreteRange -> DiscreteRange -> Bool) -> Eq DiscreteRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiscreteRange -> DiscreteRange -> Bool
$c/= :: DiscreteRange -> DiscreteRange -> Bool
== :: DiscreteRange -> DiscreteRange -> Bool
$c== :: DiscreteRange -> DiscreteRange -> Bool
Eq, Int -> DiscreteRange -> ShowS
[DiscreteRange] -> ShowS
DiscreteRange -> String
(Int -> DiscreteRange -> ShowS)
-> (DiscreteRange -> String)
-> ([DiscreteRange] -> ShowS)
-> Show DiscreteRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiscreteRange] -> ShowS
$cshowList :: [DiscreteRange] -> ShowS
show :: DiscreteRange -> String
$cshow :: DiscreteRange -> String
showsPrec :: Int -> DiscreteRange -> ShowS
$cshowsPrec :: Int -> DiscreteRange -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 3.2.1.1 Index constraints and discrete ranges

-- constraints ... todo

--------------------------------------------------------------------------------
-- *** 3.2.1.2 Predefined array types

-- predefined ... todo

--------------------------------------------------------------------------------
-- ** 3.2.2 Record types
{-
    record_type_definition ::=
      RECORD
        element_declaration
	{ element_declaration }
      END RECORD [ record_type_simple_name ]

    element_declaration ::=
      identifier_list : element_subtype_definition ;

    identifier_list ::= identifier { , identifier }

    element_subtype_definition ::= subtype_indication
-}

data RecordTypeDefinition = RecordTypeDefinition {
    RecordTypeDefinition -> [ElementDeclaration]
rectd_element_declaration :: [ElementDeclaration]
  , RecordTypeDefinition -> Maybe Identifier
rectd_type_simple_name    :: Maybe SimpleName
  }
  deriving (RecordTypeDefinition -> RecordTypeDefinition -> Bool
(RecordTypeDefinition -> RecordTypeDefinition -> Bool)
-> (RecordTypeDefinition -> RecordTypeDefinition -> Bool)
-> Eq RecordTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordTypeDefinition -> RecordTypeDefinition -> Bool
$c/= :: RecordTypeDefinition -> RecordTypeDefinition -> Bool
== :: RecordTypeDefinition -> RecordTypeDefinition -> Bool
$c== :: RecordTypeDefinition -> RecordTypeDefinition -> Bool
Eq, Int -> RecordTypeDefinition -> ShowS
[RecordTypeDefinition] -> ShowS
RecordTypeDefinition -> String
(Int -> RecordTypeDefinition -> ShowS)
-> (RecordTypeDefinition -> String)
-> ([RecordTypeDefinition] -> ShowS)
-> Show RecordTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordTypeDefinition] -> ShowS
$cshowList :: [RecordTypeDefinition] -> ShowS
show :: RecordTypeDefinition -> String
$cshow :: RecordTypeDefinition -> String
showsPrec :: Int -> RecordTypeDefinition -> ShowS
$cshowsPrec :: Int -> RecordTypeDefinition -> ShowS
Show)

data ElementDeclaration = ElementDeclaration {
    ElementDeclaration -> IdentifierList
elemd_identifier_list    :: IdentifierList
  , ElementDeclaration -> SubtypeIndication
elemd_subtype_definition :: ElementSubtypeDefinition
  }
  deriving (ElementDeclaration -> ElementDeclaration -> Bool
(ElementDeclaration -> ElementDeclaration -> Bool)
-> (ElementDeclaration -> ElementDeclaration -> Bool)
-> Eq ElementDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementDeclaration -> ElementDeclaration -> Bool
$c/= :: ElementDeclaration -> ElementDeclaration -> Bool
== :: ElementDeclaration -> ElementDeclaration -> Bool
$c== :: ElementDeclaration -> ElementDeclaration -> Bool
Eq, Int -> ElementDeclaration -> ShowS
[ElementDeclaration] -> ShowS
ElementDeclaration -> String
(Int -> ElementDeclaration -> ShowS)
-> (ElementDeclaration -> String)
-> ([ElementDeclaration] -> ShowS)
-> Show ElementDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElementDeclaration] -> ShowS
$cshowList :: [ElementDeclaration] -> ShowS
show :: ElementDeclaration -> String
$cshow :: ElementDeclaration -> String
showsPrec :: Int -> ElementDeclaration -> ShowS
$cshowsPrec :: Int -> ElementDeclaration -> ShowS
Show)

type IdentifierList           = [Identifier]

type ElementSubtypeDefinition = SubtypeIndication

--------------------------------------------------------------------------------
-- * 3.3 Access types
{-
    access_type_definition ::= ACCESS subtype_indication
-}

data AccessTypeDefinition = AccessTypeDefinition SubtypeIndication
  deriving (AccessTypeDefinition -> AccessTypeDefinition -> Bool
(AccessTypeDefinition -> AccessTypeDefinition -> Bool)
-> (AccessTypeDefinition -> AccessTypeDefinition -> Bool)
-> Eq AccessTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessTypeDefinition -> AccessTypeDefinition -> Bool
$c/= :: AccessTypeDefinition -> AccessTypeDefinition -> Bool
== :: AccessTypeDefinition -> AccessTypeDefinition -> Bool
$c== :: AccessTypeDefinition -> AccessTypeDefinition -> Bool
Eq, Int -> AccessTypeDefinition -> ShowS
[AccessTypeDefinition] -> ShowS
AccessTypeDefinition -> String
(Int -> AccessTypeDefinition -> ShowS)
-> (AccessTypeDefinition -> String)
-> ([AccessTypeDefinition] -> ShowS)
-> Show AccessTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessTypeDefinition] -> ShowS
$cshowList :: [AccessTypeDefinition] -> ShowS
show :: AccessTypeDefinition -> String
$cshow :: AccessTypeDefinition -> String
showsPrec :: Int -> AccessTypeDefinition -> ShowS
$cshowsPrec :: Int -> AccessTypeDefinition -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 3.3.1 Incomplete type declarations
{-
    incomplete_type_declaration ::= TYPE identifier ;
-}

data IncompleteTypeDeclaration = IncompleteTypeDeclaration Identifier
  deriving (IncompleteTypeDeclaration -> IncompleteTypeDeclaration -> Bool
(IncompleteTypeDeclaration -> IncompleteTypeDeclaration -> Bool)
-> (IncompleteTypeDeclaration -> IncompleteTypeDeclaration -> Bool)
-> Eq IncompleteTypeDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncompleteTypeDeclaration -> IncompleteTypeDeclaration -> Bool
$c/= :: IncompleteTypeDeclaration -> IncompleteTypeDeclaration -> Bool
== :: IncompleteTypeDeclaration -> IncompleteTypeDeclaration -> Bool
$c== :: IncompleteTypeDeclaration -> IncompleteTypeDeclaration -> Bool
Eq, Int -> IncompleteTypeDeclaration -> ShowS
[IncompleteTypeDeclaration] -> ShowS
IncompleteTypeDeclaration -> String
(Int -> IncompleteTypeDeclaration -> ShowS)
-> (IncompleteTypeDeclaration -> String)
-> ([IncompleteTypeDeclaration] -> ShowS)
-> Show IncompleteTypeDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IncompleteTypeDeclaration] -> ShowS
$cshowList :: [IncompleteTypeDeclaration] -> ShowS
show :: IncompleteTypeDeclaration -> String
$cshow :: IncompleteTypeDeclaration -> String
showsPrec :: Int -> IncompleteTypeDeclaration -> ShowS
$cshowsPrec :: Int -> IncompleteTypeDeclaration -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 3.3.2 Allocation and deallocation of objects

-- ?

--------------------------------------------------------------------------------
-- * 3.4 File types
{-
    file_type_definition ::= FILE OF type_mark
-}

data FileTypeDefinition = FileTypeDefinition TypeMark
  deriving (FileTypeDefinition -> FileTypeDefinition -> Bool
(FileTypeDefinition -> FileTypeDefinition -> Bool)
-> (FileTypeDefinition -> FileTypeDefinition -> Bool)
-> Eq FileTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileTypeDefinition -> FileTypeDefinition -> Bool
$c/= :: FileTypeDefinition -> FileTypeDefinition -> Bool
== :: FileTypeDefinition -> FileTypeDefinition -> Bool
$c== :: FileTypeDefinition -> FileTypeDefinition -> Bool
Eq, Int -> FileTypeDefinition -> ShowS
[FileTypeDefinition] -> ShowS
FileTypeDefinition -> String
(Int -> FileTypeDefinition -> ShowS)
-> (FileTypeDefinition -> String)
-> ([FileTypeDefinition] -> ShowS)
-> Show FileTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileTypeDefinition] -> ShowS
$cshowList :: [FileTypeDefinition] -> ShowS
show :: FileTypeDefinition -> String
$cshow :: FileTypeDefinition -> String
showsPrec :: Int -> FileTypeDefinition -> ShowS
$cshowsPrec :: Int -> FileTypeDefinition -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 3.4.1 File operations

-- ?

--------------------------------------------------------------------------------
-- * 3.5 Protected types

-- I'll skip these for now..

--------------------------------------------------------------------------------
--
--                                   -- 4 --
--
--                                Declarations
--
--------------------------------------------------------------------------------
{-
    declaration ::=
        type_declaration
      | subtype_declaration
      | object_declaration
      | interface_declaration
      | alias_declaration
      | attribute_declaration
      | component_declaration
      | group_template_declaration
      | group_declaration
      | entity_declaration
      | configuration_declaration
      | subprogram_declaration
      | package_declaration
-}

data Declaration = 
    DType          TypeDeclaration
  | DSubtype       SubtypeDeclaration
  | DObject        ObjectDeclaration
  | DAlias         AliasDeclaration
  | DComponent     ComponentDeclaration
  | DAttribute     AttributeDeclaration
  | DGroupTemplate GroupTemplateDeclaration
  | DGroup         GroupDeclaration
  | DEntity        EntityDeclaration
  | DConfiguration ConfigurationDeclaration
  | DSubprogram    SubprogramDeclaration
  | DPackage       PackageDeclaration
  deriving (Declaration -> Declaration -> Bool
(Declaration -> Declaration -> Bool)
-> (Declaration -> Declaration -> Bool) -> Eq Declaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Declaration -> Declaration -> Bool
$c/= :: Declaration -> Declaration -> Bool
== :: Declaration -> Declaration -> Bool
$c== :: Declaration -> Declaration -> Bool
Eq, Int -> Declaration -> ShowS
[Declaration] -> ShowS
Declaration -> String
(Int -> Declaration -> ShowS)
-> (Declaration -> String)
-> ([Declaration] -> ShowS)
-> Show Declaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Declaration] -> ShowS
$cshowList :: [Declaration] -> ShowS
show :: Declaration -> String
$cshow :: Declaration -> String
showsPrec :: Int -> Declaration -> ShowS
$cshowsPrec :: Int -> Declaration -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 4.1 Type declarations
{-
    type_declaration ::=
        full_type_declaration
      | incomplete_type_declaration

    full_type_declaration ::=
      TYPE identifier IS type_definition ;

    type_definition ::=
        scalar_type_definition
      | composite_type_definition
      | access_type_definition
      | file_type_definition
      | protected_type_definition  -- missing from ref. manual
-}

data TypeDeclaration = TDFull FullTypeDeclaration | TDPartial IncompleteTypeDeclaration
  deriving (TypeDeclaration -> TypeDeclaration -> Bool
(TypeDeclaration -> TypeDeclaration -> Bool)
-> (TypeDeclaration -> TypeDeclaration -> Bool)
-> Eq TypeDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeDeclaration -> TypeDeclaration -> Bool
$c/= :: TypeDeclaration -> TypeDeclaration -> Bool
== :: TypeDeclaration -> TypeDeclaration -> Bool
$c== :: TypeDeclaration -> TypeDeclaration -> Bool
Eq, Int -> TypeDeclaration -> ShowS
[TypeDeclaration] -> ShowS
TypeDeclaration -> String
(Int -> TypeDeclaration -> ShowS)
-> (TypeDeclaration -> String)
-> ([TypeDeclaration] -> ShowS)
-> Show TypeDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeDeclaration] -> ShowS
$cshowList :: [TypeDeclaration] -> ShowS
show :: TypeDeclaration -> String
$cshow :: TypeDeclaration -> String
showsPrec :: Int -> TypeDeclaration -> ShowS
$cshowsPrec :: Int -> TypeDeclaration -> ShowS
Show)

data FullTypeDeclaration = FullTypeDeclaration {
    FullTypeDeclaration -> Identifier
ftd_identifier      :: Identifier
  , FullTypeDeclaration -> TypeDefinition
ftd_type_definition :: TypeDefinition
  }
  deriving (FullTypeDeclaration -> FullTypeDeclaration -> Bool
(FullTypeDeclaration -> FullTypeDeclaration -> Bool)
-> (FullTypeDeclaration -> FullTypeDeclaration -> Bool)
-> Eq FullTypeDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FullTypeDeclaration -> FullTypeDeclaration -> Bool
$c/= :: FullTypeDeclaration -> FullTypeDeclaration -> Bool
== :: FullTypeDeclaration -> FullTypeDeclaration -> Bool
$c== :: FullTypeDeclaration -> FullTypeDeclaration -> Bool
Eq, Int -> FullTypeDeclaration -> ShowS
[FullTypeDeclaration] -> ShowS
FullTypeDeclaration -> String
(Int -> FullTypeDeclaration -> ShowS)
-> (FullTypeDeclaration -> String)
-> ([FullTypeDeclaration] -> ShowS)
-> Show FullTypeDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullTypeDeclaration] -> ShowS
$cshowList :: [FullTypeDeclaration] -> ShowS
show :: FullTypeDeclaration -> String
$cshow :: FullTypeDeclaration -> String
showsPrec :: Int -> FullTypeDeclaration -> ShowS
$cshowsPrec :: Int -> FullTypeDeclaration -> ShowS
Show)

data TypeDefinition =
    TDScalar       ScalarTypeDefinition
  | TDComposite CompositeTypeDefinition
  | TDAccess       AccessTypeDefinition
  | TDFile           FileTypeDefinition
--  | TDProt      ProtectedTypeDefinition
  deriving (TypeDefinition -> TypeDefinition -> Bool
(TypeDefinition -> TypeDefinition -> Bool)
-> (TypeDefinition -> TypeDefinition -> Bool) -> Eq TypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeDefinition -> TypeDefinition -> Bool
$c/= :: TypeDefinition -> TypeDefinition -> Bool
== :: TypeDefinition -> TypeDefinition -> Bool
$c== :: TypeDefinition -> TypeDefinition -> Bool
Eq, Int -> TypeDefinition -> ShowS
[TypeDefinition] -> ShowS
TypeDefinition -> String
(Int -> TypeDefinition -> ShowS)
-> (TypeDefinition -> String)
-> ([TypeDefinition] -> ShowS)
-> Show TypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeDefinition] -> ShowS
$cshowList :: [TypeDefinition] -> ShowS
show :: TypeDefinition -> String
$cshow :: TypeDefinition -> String
showsPrec :: Int -> TypeDefinition -> ShowS
$cshowsPrec :: Int -> TypeDefinition -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 4.2 Subtype declarations
{-
    subtype_declaration ::=
      SUBTYPE identifier IS subtype_indication ;

    subtype_indication ::=
      [ resolution_function_name ] type_mark [ constraint ]

    type_mark ::=
        type_name
      | subtype_name

    constraint ::=
        range_constraint
      | index_constraint
-}

data SubtypeDeclaration = SubtypeDeclaration {
    SubtypeDeclaration -> Identifier
sd_identifier               :: Identifier
  , SubtypeDeclaration -> SubtypeIndication
sd_indication               :: SubtypeIndication
  }
  deriving (SubtypeDeclaration -> SubtypeDeclaration -> Bool
(SubtypeDeclaration -> SubtypeDeclaration -> Bool)
-> (SubtypeDeclaration -> SubtypeDeclaration -> Bool)
-> Eq SubtypeDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubtypeDeclaration -> SubtypeDeclaration -> Bool
$c/= :: SubtypeDeclaration -> SubtypeDeclaration -> Bool
== :: SubtypeDeclaration -> SubtypeDeclaration -> Bool
$c== :: SubtypeDeclaration -> SubtypeDeclaration -> Bool
Eq, Int -> SubtypeDeclaration -> ShowS
[SubtypeDeclaration] -> ShowS
SubtypeDeclaration -> String
(Int -> SubtypeDeclaration -> ShowS)
-> (SubtypeDeclaration -> String)
-> ([SubtypeDeclaration] -> ShowS)
-> Show SubtypeDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubtypeDeclaration] -> ShowS
$cshowList :: [SubtypeDeclaration] -> ShowS
show :: SubtypeDeclaration -> String
$cshow :: SubtypeDeclaration -> String
showsPrec :: Int -> SubtypeDeclaration -> ShowS
$cshowsPrec :: Int -> SubtypeDeclaration -> ShowS
Show)

data SubtypeIndication = SubtypeIndication {
    SubtypeIndication -> Maybe Name
si_resolution_function_name :: Maybe Name
  , SubtypeIndication -> TypeMark
si_type_mark                :: TypeMark
  , SubtypeIndication -> Maybe Constraint
si_constraint               :: Maybe Constraint
  }
  deriving (SubtypeIndication -> SubtypeIndication -> Bool
(SubtypeIndication -> SubtypeIndication -> Bool)
-> (SubtypeIndication -> SubtypeIndication -> Bool)
-> Eq SubtypeIndication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubtypeIndication -> SubtypeIndication -> Bool
$c/= :: SubtypeIndication -> SubtypeIndication -> Bool
== :: SubtypeIndication -> SubtypeIndication -> Bool
$c== :: SubtypeIndication -> SubtypeIndication -> Bool
Eq, Int -> SubtypeIndication -> ShowS
[SubtypeIndication] -> ShowS
SubtypeIndication -> String
(Int -> SubtypeIndication -> ShowS)
-> (SubtypeIndication -> String)
-> ([SubtypeIndication] -> ShowS)
-> Show SubtypeIndication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubtypeIndication] -> ShowS
$cshowList :: [SubtypeIndication] -> ShowS
show :: SubtypeIndication -> String
$cshow :: SubtypeIndication -> String
showsPrec :: Int -> SubtypeIndication -> ShowS
$cshowsPrec :: Int -> SubtypeIndication -> ShowS
Show)

data TypeMark   = TMType Name | TMSubtype Name
  deriving (TypeMark -> TypeMark -> Bool
(TypeMark -> TypeMark -> Bool)
-> (TypeMark -> TypeMark -> Bool) -> Eq TypeMark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeMark -> TypeMark -> Bool
$c/= :: TypeMark -> TypeMark -> Bool
== :: TypeMark -> TypeMark -> Bool
$c== :: TypeMark -> TypeMark -> Bool
Eq, Int -> TypeMark -> ShowS
[TypeMark] -> ShowS
TypeMark -> String
(Int -> TypeMark -> ShowS)
-> (TypeMark -> String) -> ([TypeMark] -> ShowS) -> Show TypeMark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeMark] -> ShowS
$cshowList :: [TypeMark] -> ShowS
show :: TypeMark -> String
$cshow :: TypeMark -> String
showsPrec :: Int -> TypeMark -> ShowS
$cshowsPrec :: Int -> TypeMark -> ShowS
Show)

data Constraint = CRange RangeConstraint | CIndex IndexConstraint
  deriving (Constraint -> Constraint -> Bool
(Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool) -> Eq Constraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c== :: Constraint -> Constraint -> Bool
Eq, Int -> Constraint -> ShowS
[Constraint] -> ShowS
Constraint -> String
(Int -> Constraint -> ShowS)
-> (Constraint -> String)
-> ([Constraint] -> ShowS)
-> Show Constraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constraint] -> ShowS
$cshowList :: [Constraint] -> ShowS
show :: Constraint -> String
$cshow :: Constraint -> String
showsPrec :: Int -> Constraint -> ShowS
$cshowsPrec :: Int -> Constraint -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 4.3 Objects

--------------------------------------------------------------------------------
-- ** 4.3.1 Object declarations
{-
    object_declaration ::=
        constant_declaration
      | signal_declaration
      | variable_declaration
      | file_declaration
-}

data ObjectDeclaration =
    ObjConst ConstantDeclaration
  | ObjSig     SignalDeclaration
  | ObjVar   VariableDeclaration
  | ObjFile      FileDeclaration
  deriving (ObjectDeclaration -> ObjectDeclaration -> Bool
(ObjectDeclaration -> ObjectDeclaration -> Bool)
-> (ObjectDeclaration -> ObjectDeclaration -> Bool)
-> Eq ObjectDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectDeclaration -> ObjectDeclaration -> Bool
$c/= :: ObjectDeclaration -> ObjectDeclaration -> Bool
== :: ObjectDeclaration -> ObjectDeclaration -> Bool
$c== :: ObjectDeclaration -> ObjectDeclaration -> Bool
Eq, Int -> ObjectDeclaration -> ShowS
[ObjectDeclaration] -> ShowS
ObjectDeclaration -> String
(Int -> ObjectDeclaration -> ShowS)
-> (ObjectDeclaration -> String)
-> ([ObjectDeclaration] -> ShowS)
-> Show ObjectDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectDeclaration] -> ShowS
$cshowList :: [ObjectDeclaration] -> ShowS
show :: ObjectDeclaration -> String
$cshow :: ObjectDeclaration -> String
showsPrec :: Int -> ObjectDeclaration -> ShowS
$cshowsPrec :: Int -> ObjectDeclaration -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 4.3.1.1 Constant declarations
{-
    constant_declaration ::=
      CONSTANT identifier_list : subtype_indication [ := expression ] ;
-}

data ConstantDeclaration = ConstantDeclaration {
    ConstantDeclaration -> IdentifierList
const_identifier_list    :: IdentifierList
  , ConstantDeclaration -> SubtypeIndication
const_subtype_indication :: SubtypeIndication
  , ConstantDeclaration -> Maybe Expression
const_expression         :: Maybe Expression
  }
  deriving (ConstantDeclaration -> ConstantDeclaration -> Bool
(ConstantDeclaration -> ConstantDeclaration -> Bool)
-> (ConstantDeclaration -> ConstantDeclaration -> Bool)
-> Eq ConstantDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstantDeclaration -> ConstantDeclaration -> Bool
$c/= :: ConstantDeclaration -> ConstantDeclaration -> Bool
== :: ConstantDeclaration -> ConstantDeclaration -> Bool
$c== :: ConstantDeclaration -> ConstantDeclaration -> Bool
Eq, Int -> ConstantDeclaration -> ShowS
[ConstantDeclaration] -> ShowS
ConstantDeclaration -> String
(Int -> ConstantDeclaration -> ShowS)
-> (ConstantDeclaration -> String)
-> ([ConstantDeclaration] -> ShowS)
-> Show ConstantDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstantDeclaration] -> ShowS
$cshowList :: [ConstantDeclaration] -> ShowS
show :: ConstantDeclaration -> String
$cshow :: ConstantDeclaration -> String
showsPrec :: Int -> ConstantDeclaration -> ShowS
$cshowsPrec :: Int -> ConstantDeclaration -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 4.3.1.2 Signal declarations
{-
    signal_declaration ::=
      SIGNAL identifier_list : subtype_indication [ signal_kind ] [ := expression ] ;

    signal_kind ::= REGISTER | BUS
-}

data SignalDeclaration = SignalDeclaration {
    SignalDeclaration -> IdentifierList
signal_identifier_list    :: IdentifierList
  , SignalDeclaration -> SubtypeIndication
signal_subtype_indication :: SubtypeIndication
  , SignalDeclaration -> Maybe SignalKind
signal_kind               :: Maybe SignalKind
  , SignalDeclaration -> Maybe Expression
signal_expression         :: Maybe Expression
  }
  deriving (SignalDeclaration -> SignalDeclaration -> Bool
(SignalDeclaration -> SignalDeclaration -> Bool)
-> (SignalDeclaration -> SignalDeclaration -> Bool)
-> Eq SignalDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalDeclaration -> SignalDeclaration -> Bool
$c/= :: SignalDeclaration -> SignalDeclaration -> Bool
== :: SignalDeclaration -> SignalDeclaration -> Bool
$c== :: SignalDeclaration -> SignalDeclaration -> Bool
Eq, Int -> SignalDeclaration -> ShowS
[SignalDeclaration] -> ShowS
SignalDeclaration -> String
(Int -> SignalDeclaration -> ShowS)
-> (SignalDeclaration -> String)
-> ([SignalDeclaration] -> ShowS)
-> Show SignalDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignalDeclaration] -> ShowS
$cshowList :: [SignalDeclaration] -> ShowS
show :: SignalDeclaration -> String
$cshow :: SignalDeclaration -> String
showsPrec :: Int -> SignalDeclaration -> ShowS
$cshowsPrec :: Int -> SignalDeclaration -> ShowS
Show)

data SignalKind = Register | Bus
  deriving (SignalKind -> SignalKind -> Bool
(SignalKind -> SignalKind -> Bool)
-> (SignalKind -> SignalKind -> Bool) -> Eq SignalKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalKind -> SignalKind -> Bool
$c/= :: SignalKind -> SignalKind -> Bool
== :: SignalKind -> SignalKind -> Bool
$c== :: SignalKind -> SignalKind -> Bool
Eq, Int -> SignalKind -> ShowS
[SignalKind] -> ShowS
SignalKind -> String
(Int -> SignalKind -> ShowS)
-> (SignalKind -> String)
-> ([SignalKind] -> ShowS)
-> Show SignalKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignalKind] -> ShowS
$cshowList :: [SignalKind] -> ShowS
show :: SignalKind -> String
$cshow :: SignalKind -> String
showsPrec :: Int -> SignalKind -> ShowS
$cshowsPrec :: Int -> SignalKind -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 4.3.1.3 Variable declarations
{-
    variable_declaration ::=
      [ SHARED ] VARIABLE identifier_list : subtype_indication [ := expression ] ;
-}

data VariableDeclaration = VariableDeclaration {
    VariableDeclaration -> Bool
var_shared             :: Bool
  , VariableDeclaration -> IdentifierList
var_identifier_list    :: IdentifierList
  , VariableDeclaration -> SubtypeIndication
var_subtype_indication :: SubtypeIndication
  , VariableDeclaration -> Maybe Expression
var_expression         :: Maybe Expression
  }
  deriving (VariableDeclaration -> VariableDeclaration -> Bool
(VariableDeclaration -> VariableDeclaration -> Bool)
-> (VariableDeclaration -> VariableDeclaration -> Bool)
-> Eq VariableDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariableDeclaration -> VariableDeclaration -> Bool
$c/= :: VariableDeclaration -> VariableDeclaration -> Bool
== :: VariableDeclaration -> VariableDeclaration -> Bool
$c== :: VariableDeclaration -> VariableDeclaration -> Bool
Eq, Int -> VariableDeclaration -> ShowS
[VariableDeclaration] -> ShowS
VariableDeclaration -> String
(Int -> VariableDeclaration -> ShowS)
-> (VariableDeclaration -> String)
-> ([VariableDeclaration] -> ShowS)
-> Show VariableDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariableDeclaration] -> ShowS
$cshowList :: [VariableDeclaration] -> ShowS
show :: VariableDeclaration -> String
$cshow :: VariableDeclaration -> String
showsPrec :: Int -> VariableDeclaration -> ShowS
$cshowsPrec :: Int -> VariableDeclaration -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 4.3.1.4 File declarations
{-
    file_declaration ::=
      FILE identifier_list : subtype_indication [ file_open_information ] ;

    file_open_information ::=
      [ OPEN file_open_kind_expression ] IS file_logical_name

    file_logical_name ::= string_expression
-}

data FileDeclaration = FileDeclaration {
    FileDeclaration -> IdentifierList
fd_identifier_list      :: IdentifierList
  , FileDeclaration -> SubtypeIndication
fd_subtype_indication   :: SubtypeIndication
  , FileDeclaration -> Maybe FileOpenInformation
fd_open_information     :: Maybe FileOpenInformation
  }
  deriving (FileDeclaration -> FileDeclaration -> Bool
(FileDeclaration -> FileDeclaration -> Bool)
-> (FileDeclaration -> FileDeclaration -> Bool)
-> Eq FileDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileDeclaration -> FileDeclaration -> Bool
$c/= :: FileDeclaration -> FileDeclaration -> Bool
== :: FileDeclaration -> FileDeclaration -> Bool
$c== :: FileDeclaration -> FileDeclaration -> Bool
Eq, Int -> FileDeclaration -> ShowS
[FileDeclaration] -> ShowS
FileDeclaration -> String
(Int -> FileDeclaration -> ShowS)
-> (FileDeclaration -> String)
-> ([FileDeclaration] -> ShowS)
-> Show FileDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileDeclaration] -> ShowS
$cshowList :: [FileDeclaration] -> ShowS
show :: FileDeclaration -> String
$cshow :: FileDeclaration -> String
showsPrec :: Int -> FileDeclaration -> ShowS
$cshowsPrec :: Int -> FileDeclaration -> ShowS
Show)

data FileOpenInformation = FileOpenInformation {
    FileOpenInformation -> Maybe Expression
foi_open_kind_expression :: Maybe Expression
  , FileOpenInformation -> Expression
foi_logical_name         :: FileLogicalName
  }
  deriving (FileOpenInformation -> FileOpenInformation -> Bool
(FileOpenInformation -> FileOpenInformation -> Bool)
-> (FileOpenInformation -> FileOpenInformation -> Bool)
-> Eq FileOpenInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileOpenInformation -> FileOpenInformation -> Bool
$c/= :: FileOpenInformation -> FileOpenInformation -> Bool
== :: FileOpenInformation -> FileOpenInformation -> Bool
$c== :: FileOpenInformation -> FileOpenInformation -> Bool
Eq, Int -> FileOpenInformation -> ShowS
[FileOpenInformation] -> ShowS
FileOpenInformation -> String
(Int -> FileOpenInformation -> ShowS)
-> (FileOpenInformation -> String)
-> ([FileOpenInformation] -> ShowS)
-> Show FileOpenInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileOpenInformation] -> ShowS
$cshowList :: [FileOpenInformation] -> ShowS
show :: FileOpenInformation -> String
$cshow :: FileOpenInformation -> String
showsPrec :: Int -> FileOpenInformation -> ShowS
$cshowsPrec :: Int -> FileOpenInformation -> ShowS
Show)

type FileLogicalName = Expression

--------------------------------------------------------------------------------
-- ** 4.3.2 Interface declarations
{-
    interface_declaration ::=
        interface_constant_declaration
      | interface_signal_declaration
      | interface_variable_declaration
      | interface_file_declaration

    interface_constant_declaration ::=
      [ CONSTANT ] identifier_list : [ IN ] subtype_indication [ := static_expression ]

    interface_signal_declaration ::=
      [ SIGNAL ] identifier_list : [ mode ] subtype_indication [ BUS ] [ := static_expression ]

    interface_variable_declaration ::=
      [ VARIABLE ] identifier_list : [ mode ] subtype_indication [ := static_expression ]

    interface_file_declaration ::=
	FILE identifier_list : subtype_indication

    mode ::= IN | OUT | INOUT | BUFFER | LINKAGE
-}

data InterfaceDeclaration
  = InterfaceConstantDeclaration {
        InterfaceDeclaration -> IdentifierList
idecl_identifier_list     :: IdentifierList
      , InterfaceDeclaration -> SubtypeIndication
iconst_subtype_indication :: SubtypeIndication
      , InterfaceDeclaration -> Maybe Expression
iconst_static_expression  :: Maybe Expression
    }
  | InterfaceSignalDeclaration {
        idecl_identifier_list     :: IdentifierList
      , InterfaceDeclaration -> Maybe Mode
isig_mode                 :: Maybe Mode
      , InterfaceDeclaration -> SubtypeIndication
isig_subtype_indication   :: SubtypeIndication
      , InterfaceDeclaration -> Bool
isig_bus                  :: Bool
      , InterfaceDeclaration -> Maybe Expression
isig_static_expression    :: Maybe Expression
    }
  | InterfaceVariableDeclaration {
        idecl_identifier_list     :: IdentifierList
      , InterfaceDeclaration -> Maybe Mode
ivar_mode                 :: Maybe Mode
      , InterfaceDeclaration -> SubtypeIndication
ivar_subtype_indication   :: SubtypeIndication
      , InterfaceDeclaration -> Maybe Expression
ivar_static_expression    :: Maybe Expression
    }
  | InterfaceFileDeclaration {
        idecl_identifier_list     :: IdentifierList
      , InterfaceDeclaration -> SubtypeIndication
ifile_subtype_indication  :: SubtypeIndication
    }
  deriving (InterfaceDeclaration -> InterfaceDeclaration -> Bool
(InterfaceDeclaration -> InterfaceDeclaration -> Bool)
-> (InterfaceDeclaration -> InterfaceDeclaration -> Bool)
-> Eq InterfaceDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InterfaceDeclaration -> InterfaceDeclaration -> Bool
$c/= :: InterfaceDeclaration -> InterfaceDeclaration -> Bool
== :: InterfaceDeclaration -> InterfaceDeclaration -> Bool
$c== :: InterfaceDeclaration -> InterfaceDeclaration -> Bool
Eq, Int -> InterfaceDeclaration -> ShowS
[InterfaceDeclaration] -> ShowS
InterfaceDeclaration -> String
(Int -> InterfaceDeclaration -> ShowS)
-> (InterfaceDeclaration -> String)
-> ([InterfaceDeclaration] -> ShowS)
-> Show InterfaceDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InterfaceDeclaration] -> ShowS
$cshowList :: [InterfaceDeclaration] -> ShowS
show :: InterfaceDeclaration -> String
$cshow :: InterfaceDeclaration -> String
showsPrec :: Int -> InterfaceDeclaration -> ShowS
$cshowsPrec :: Int -> InterfaceDeclaration -> ShowS
Show)

data Mode = In | Out | InOut | Buffer | Linkage
  deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 4.3.2.1 Interface lists
{-
    interface_list ::= interface_element { ; interface_element }

    interface_element ::= interface_declaration
-}

data InterfaceList    = InterfaceList [InterfaceElement]
  deriving (FormalParameterList -> FormalParameterList -> Bool
(FormalParameterList -> FormalParameterList -> Bool)
-> (FormalParameterList -> FormalParameterList -> Bool)
-> Eq FormalParameterList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormalParameterList -> FormalParameterList -> Bool
$c/= :: FormalParameterList -> FormalParameterList -> Bool
== :: FormalParameterList -> FormalParameterList -> Bool
$c== :: FormalParameterList -> FormalParameterList -> Bool
Eq, Int -> FormalParameterList -> ShowS
[FormalParameterList] -> ShowS
FormalParameterList -> String
(Int -> FormalParameterList -> ShowS)
-> (FormalParameterList -> String)
-> ([FormalParameterList] -> ShowS)
-> Show FormalParameterList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormalParameterList] -> ShowS
$cshowList :: [FormalParameterList] -> ShowS
show :: FormalParameterList -> String
$cshow :: FormalParameterList -> String
showsPrec :: Int -> FormalParameterList -> ShowS
$cshowsPrec :: Int -> FormalParameterList -> ShowS
Show)

type InterfaceElement = InterfaceDeclaration

--------------------------------------------------------------------------------
-- *** 4.3.2.2 Association lists
{-
    association_element ::=
      [ formal_part => ] actual_part

    association_list ::=
      association_element { , association_element }

    formal_designator ::=
        generic_name
      | port_name
      | parameter_name

    formal_part ::=
        formal_designator
      | function_name ( formal_designator )
      | type_mark ( formal_designator )

    actual_designator ::=
	expression
      | signal_name
      | variable_name
      | file_name
      | OPEN

    actual_part ::=
        actual_designator
      | function_name ( actual_designator )
      | type_mark ( actual_designator )
-}

data AssociationElement = AssociationElement {
    AssociationElement -> Maybe FormalPart
assoc_formal_part :: Maybe FormalPart
  , AssociationElement -> ActualPart
assoc_actual_part :: ActualPart
  }
  deriving (AssociationElement -> AssociationElement -> Bool
(AssociationElement -> AssociationElement -> Bool)
-> (AssociationElement -> AssociationElement -> Bool)
-> Eq AssociationElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociationElement -> AssociationElement -> Bool
$c/= :: AssociationElement -> AssociationElement -> Bool
== :: AssociationElement -> AssociationElement -> Bool
$c== :: AssociationElement -> AssociationElement -> Bool
Eq, Int -> AssociationElement -> ShowS
[AssociationElement] -> ShowS
AssociationElement -> String
(Int -> AssociationElement -> ShowS)
-> (AssociationElement -> String)
-> ([AssociationElement] -> ShowS)
-> Show AssociationElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociationElement] -> ShowS
$cshowList :: [AssociationElement] -> ShowS
show :: AssociationElement -> String
$cshow :: AssociationElement -> String
showsPrec :: Int -> AssociationElement -> ShowS
$cshowsPrec :: Int -> AssociationElement -> ShowS
Show)

data AssociationList = AssociationList [AssociationElement]
  deriving (AssociationList -> AssociationList -> Bool
(AssociationList -> AssociationList -> Bool)
-> (AssociationList -> AssociationList -> Bool)
-> Eq AssociationList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociationList -> AssociationList -> Bool
$c/= :: AssociationList -> AssociationList -> Bool
== :: AssociationList -> AssociationList -> Bool
$c== :: AssociationList -> AssociationList -> Bool
Eq, Int -> AssociationList -> ShowS
[AssociationList] -> ShowS
AssociationList -> String
(Int -> AssociationList -> ShowS)
-> (AssociationList -> String)
-> ([AssociationList] -> ShowS)
-> Show AssociationList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociationList] -> ShowS
$cshowList :: [AssociationList] -> ShowS
show :: AssociationList -> String
$cshow :: AssociationList -> String
showsPrec :: Int -> AssociationList -> ShowS
$cshowsPrec :: Int -> AssociationList -> ShowS
Show)

data FormalDesignator =
    FDGeneric   Name
  | FDPort      Name
  | FDParameter Name
  deriving (FormalDesignator -> FormalDesignator -> Bool
(FormalDesignator -> FormalDesignator -> Bool)
-> (FormalDesignator -> FormalDesignator -> Bool)
-> Eq FormalDesignator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormalDesignator -> FormalDesignator -> Bool
$c/= :: FormalDesignator -> FormalDesignator -> Bool
== :: FormalDesignator -> FormalDesignator -> Bool
$c== :: FormalDesignator -> FormalDesignator -> Bool
Eq, Int -> FormalDesignator -> ShowS
[FormalDesignator] -> ShowS
FormalDesignator -> String
(Int -> FormalDesignator -> ShowS)
-> (FormalDesignator -> String)
-> ([FormalDesignator] -> ShowS)
-> Show FormalDesignator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormalDesignator] -> ShowS
$cshowList :: [FormalDesignator] -> ShowS
show :: FormalDesignator -> String
$cshow :: FormalDesignator -> String
showsPrec :: Int -> FormalDesignator -> ShowS
$cshowsPrec :: Int -> FormalDesignator -> ShowS
Show)

data FormalPart =
    FPDesignator          FormalDesignator
  | FPFunction   Name     FormalDesignator
  | FPType       TypeMark FormalDesignator
  deriving (FormalPart -> FormalPart -> Bool
(FormalPart -> FormalPart -> Bool)
-> (FormalPart -> FormalPart -> Bool) -> Eq FormalPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormalPart -> FormalPart -> Bool
$c/= :: FormalPart -> FormalPart -> Bool
== :: FormalPart -> FormalPart -> Bool
$c== :: FormalPart -> FormalPart -> Bool
Eq, Int -> FormalPart -> ShowS
[FormalPart] -> ShowS
FormalPart -> String
(Int -> FormalPart -> ShowS)
-> (FormalPart -> String)
-> ([FormalPart] -> ShowS)
-> Show FormalPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormalPart] -> ShowS
$cshowList :: [FormalPart] -> ShowS
show :: FormalPart -> String
$cshow :: FormalPart -> String
showsPrec :: Int -> FormalPart -> ShowS
$cshowsPrec :: Int -> FormalPart -> ShowS
Show)

data ActualDesignator =
    ADExpression  Expression
  | ADSignal      Name
  | ADVariable    Name
  | ADFile        Name
  | ADOpen
  deriving (ActualDesignator -> ActualDesignator -> Bool
(ActualDesignator -> ActualDesignator -> Bool)
-> (ActualDesignator -> ActualDesignator -> Bool)
-> Eq ActualDesignator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActualDesignator -> ActualDesignator -> Bool
$c/= :: ActualDesignator -> ActualDesignator -> Bool
== :: ActualDesignator -> ActualDesignator -> Bool
$c== :: ActualDesignator -> ActualDesignator -> Bool
Eq, Int -> ActualDesignator -> ShowS
[ActualDesignator] -> ShowS
ActualDesignator -> String
(Int -> ActualDesignator -> ShowS)
-> (ActualDesignator -> String)
-> ([ActualDesignator] -> ShowS)
-> Show ActualDesignator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActualDesignator] -> ShowS
$cshowList :: [ActualDesignator] -> ShowS
show :: ActualDesignator -> String
$cshow :: ActualDesignator -> String
showsPrec :: Int -> ActualDesignator -> ShowS
$cshowsPrec :: Int -> ActualDesignator -> ShowS
Show)

data ActualPart =
    APDesignator          ActualDesignator
  | APFunction   Name     ActualDesignator
  | APType       TypeMark ActualDesignator
  deriving (ActualPart -> ActualPart -> Bool
(ActualPart -> ActualPart -> Bool)
-> (ActualPart -> ActualPart -> Bool) -> Eq ActualPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActualPart -> ActualPart -> Bool
$c/= :: ActualPart -> ActualPart -> Bool
== :: ActualPart -> ActualPart -> Bool
$c== :: ActualPart -> ActualPart -> Bool
Eq, Int -> ActualPart -> ShowS
[ActualPart] -> ShowS
ActualPart -> String
(Int -> ActualPart -> ShowS)
-> (ActualPart -> String)
-> ([ActualPart] -> ShowS)
-> Show ActualPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActualPart] -> ShowS
$cshowList :: [ActualPart] -> ShowS
show :: ActualPart -> String
$cshow :: ActualPart -> String
showsPrec :: Int -> ActualPart -> ShowS
$cshowsPrec :: Int -> ActualPart -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 4.3.3 Alias declarations
{-
    alias_declaration ::=
      ALIAS alias_designator [ : subtype_indication ] IS name [ signature ] ;

    alias_designator ::= identifier | character_literal | operator_symbol
-}

data AliasDeclaration = AliasDeclaration {
    AliasDeclaration -> AliasDesignator
alias_designator         :: AliasDesignator
  , AliasDeclaration -> Maybe SubtypeIndication
alias_subtype_indication :: Maybe SubtypeIndication
  , AliasDeclaration -> Name
alias_name               :: Name
  , AliasDeclaration -> Maybe Signature
alias_signature          :: Maybe Signature
  }
  deriving (AliasDeclaration -> AliasDeclaration -> Bool
(AliasDeclaration -> AliasDeclaration -> Bool)
-> (AliasDeclaration -> AliasDeclaration -> Bool)
-> Eq AliasDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AliasDeclaration -> AliasDeclaration -> Bool
$c/= :: AliasDeclaration -> AliasDeclaration -> Bool
== :: AliasDeclaration -> AliasDeclaration -> Bool
$c== :: AliasDeclaration -> AliasDeclaration -> Bool
Eq, Int -> AliasDeclaration -> ShowS
[AliasDeclaration] -> ShowS
AliasDeclaration -> String
(Int -> AliasDeclaration -> ShowS)
-> (AliasDeclaration -> String)
-> ([AliasDeclaration] -> ShowS)
-> Show AliasDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AliasDeclaration] -> ShowS
$cshowList :: [AliasDeclaration] -> ShowS
show :: AliasDeclaration -> String
$cshow :: AliasDeclaration -> String
showsPrec :: Int -> AliasDeclaration -> ShowS
$cshowsPrec :: Int -> AliasDeclaration -> ShowS
Show)

data AliasDesignator =
    ADIdentifier Identifier
  | ADCharacter  CharacterLiteral
  | ADOperator   OperatorSymbol
  deriving (AliasDesignator -> AliasDesignator -> Bool
(AliasDesignator -> AliasDesignator -> Bool)
-> (AliasDesignator -> AliasDesignator -> Bool)
-> Eq AliasDesignator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AliasDesignator -> AliasDesignator -> Bool
$c/= :: AliasDesignator -> AliasDesignator -> Bool
== :: AliasDesignator -> AliasDesignator -> Bool
$c== :: AliasDesignator -> AliasDesignator -> Bool
Eq, Int -> AliasDesignator -> ShowS
[AliasDesignator] -> ShowS
AliasDesignator -> String
(Int -> AliasDesignator -> ShowS)
-> (AliasDesignator -> String)
-> ([AliasDesignator] -> ShowS)
-> Show AliasDesignator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AliasDesignator] -> ShowS
$cshowList :: [AliasDesignator] -> ShowS
show :: AliasDesignator -> String
$cshow :: AliasDesignator -> String
showsPrec :: Int -> AliasDesignator -> ShowS
$cshowsPrec :: Int -> AliasDesignator -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 4.3.3.1 Object aliases

--------------------------------------------------------------------------------
-- *** 4.3.3.2 Nonobject aliases

--------------------------------------------------------------------------------
-- * 4.4 Attribute declarations
{-
    attribute_declaration ::=
      ATTRIBUTE identifier : type_mark ;
-}

data AttributeDeclaration = AttributeDeclaration {
    AttributeDeclaration -> Identifier
attr_identifier :: Identifier
  , AttributeDeclaration -> TypeMark
attr_type_marke :: TypeMark
  }
  deriving (AttributeDeclaration -> AttributeDeclaration -> Bool
(AttributeDeclaration -> AttributeDeclaration -> Bool)
-> (AttributeDeclaration -> AttributeDeclaration -> Bool)
-> Eq AttributeDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeDeclaration -> AttributeDeclaration -> Bool
$c/= :: AttributeDeclaration -> AttributeDeclaration -> Bool
== :: AttributeDeclaration -> AttributeDeclaration -> Bool
$c== :: AttributeDeclaration -> AttributeDeclaration -> Bool
Eq, Int -> AttributeDeclaration -> ShowS
[AttributeDeclaration] -> ShowS
AttributeDeclaration -> String
(Int -> AttributeDeclaration -> ShowS)
-> (AttributeDeclaration -> String)
-> ([AttributeDeclaration] -> ShowS)
-> Show AttributeDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeDeclaration] -> ShowS
$cshowList :: [AttributeDeclaration] -> ShowS
show :: AttributeDeclaration -> String
$cshow :: AttributeDeclaration -> String
showsPrec :: Int -> AttributeDeclaration -> ShowS
$cshowsPrec :: Int -> AttributeDeclaration -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 4.5 Component declarations
{-
    component_declaration ::=
      COMPONENT identifier [ IS ]
        [ local_generic_clause ]
	[ local_port_clause ]
      END COMPONENT [ component_simple_name ] ;
-}

data ComponentDeclaration = ComponentDeclaration {
    ComponentDeclaration -> Identifier
comp_identifier           :: Identifier
  , ComponentDeclaration -> Maybe GenericClause
comp_local_generic_clause :: Maybe GenericClause
  , ComponentDeclaration -> Maybe PortClause
comp_local_port_clause    :: Maybe PortClause
  , ComponentDeclaration -> Maybe Identifier
comp_simple_name          :: Maybe SimpleName
  }
  deriving (ComponentDeclaration -> ComponentDeclaration -> Bool
(ComponentDeclaration -> ComponentDeclaration -> Bool)
-> (ComponentDeclaration -> ComponentDeclaration -> Bool)
-> Eq ComponentDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentDeclaration -> ComponentDeclaration -> Bool
$c/= :: ComponentDeclaration -> ComponentDeclaration -> Bool
== :: ComponentDeclaration -> ComponentDeclaration -> Bool
$c== :: ComponentDeclaration -> ComponentDeclaration -> Bool
Eq, Int -> ComponentDeclaration -> ShowS
[ComponentDeclaration] -> ShowS
ComponentDeclaration -> String
(Int -> ComponentDeclaration -> ShowS)
-> (ComponentDeclaration -> String)
-> ([ComponentDeclaration] -> ShowS)
-> Show ComponentDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentDeclaration] -> ShowS
$cshowList :: [ComponentDeclaration] -> ShowS
show :: ComponentDeclaration -> String
$cshow :: ComponentDeclaration -> String
showsPrec :: Int -> ComponentDeclaration -> ShowS
$cshowsPrec :: Int -> ComponentDeclaration -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 4.6 Group template declarations
{-
    group_template_declaration ::=
      GROUP identifier IS ( entity_class_entry_list ) ;

    entity_class_entry_list ::=
      entity_class_entry { , entity_class_entry }

    entity_class_entry ::= entity_class [ <> ]
-}

data GroupTemplateDeclaration = GroupTemplateDeclaration {
    GroupTemplateDeclaration -> Identifier
gtd_identifier              :: Identifier
  , GroupTemplateDeclaration -> EntityClassEntryList
gtd_entity_class_entry_list :: EntityClassEntryList
  }
  deriving (GroupTemplateDeclaration -> GroupTemplateDeclaration -> Bool
(GroupTemplateDeclaration -> GroupTemplateDeclaration -> Bool)
-> (GroupTemplateDeclaration -> GroupTemplateDeclaration -> Bool)
-> Eq GroupTemplateDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupTemplateDeclaration -> GroupTemplateDeclaration -> Bool
$c/= :: GroupTemplateDeclaration -> GroupTemplateDeclaration -> Bool
== :: GroupTemplateDeclaration -> GroupTemplateDeclaration -> Bool
$c== :: GroupTemplateDeclaration -> GroupTemplateDeclaration -> Bool
Eq, Int -> GroupTemplateDeclaration -> ShowS
[GroupTemplateDeclaration] -> ShowS
GroupTemplateDeclaration -> String
(Int -> GroupTemplateDeclaration -> ShowS)
-> (GroupTemplateDeclaration -> String)
-> ([GroupTemplateDeclaration] -> ShowS)
-> Show GroupTemplateDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupTemplateDeclaration] -> ShowS
$cshowList :: [GroupTemplateDeclaration] -> ShowS
show :: GroupTemplateDeclaration -> String
$cshow :: GroupTemplateDeclaration -> String
showsPrec :: Int -> GroupTemplateDeclaration -> ShowS
$cshowsPrec :: Int -> GroupTemplateDeclaration -> ShowS
Show)

type EntityClassEntryList = [EntityClassEntry]

data EntityClassEntry = EntityClassEntry {
    EntityClassEntry -> EntityClass
entc_entity_class :: EntityClass
  , EntityClassEntry -> Bool
entc_multiple     :: Bool
  }
  deriving (EntityClassEntry -> EntityClassEntry -> Bool
(EntityClassEntry -> EntityClassEntry -> Bool)
-> (EntityClassEntry -> EntityClassEntry -> Bool)
-> Eq EntityClassEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityClassEntry -> EntityClassEntry -> Bool
$c/= :: EntityClassEntry -> EntityClassEntry -> Bool
== :: EntityClassEntry -> EntityClassEntry -> Bool
$c== :: EntityClassEntry -> EntityClassEntry -> Bool
Eq, Int -> EntityClassEntry -> ShowS
EntityClassEntryList -> ShowS
EntityClassEntry -> String
(Int -> EntityClassEntry -> ShowS)
-> (EntityClassEntry -> String)
-> (EntityClassEntryList -> ShowS)
-> Show EntityClassEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: EntityClassEntryList -> ShowS
$cshowList :: EntityClassEntryList -> ShowS
show :: EntityClassEntry -> String
$cshow :: EntityClassEntry -> String
showsPrec :: Int -> EntityClassEntry -> ShowS
$cshowsPrec :: Int -> EntityClassEntry -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 4.7 Group declarations
{-
    group_declaration ::=
      GROUP identifier : group_template_name ( group_constituent_list ) ;

    group_constituent_list ::= group_constituent { , group_constituent }

    group_constituent ::= name | character_literal
-}

data GroupDeclaration = GroupDeclaration {
    GroupDeclaration -> Identifier
group_identifier       :: Identifier
  , GroupDeclaration -> Name
group_template_name    :: Name
  , GroupDeclaration -> GroupConstituentList
group_constituent_list :: GroupConstituentList
  }
  deriving (GroupDeclaration -> GroupDeclaration -> Bool
(GroupDeclaration -> GroupDeclaration -> Bool)
-> (GroupDeclaration -> GroupDeclaration -> Bool)
-> Eq GroupDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupDeclaration -> GroupDeclaration -> Bool
$c/= :: GroupDeclaration -> GroupDeclaration -> Bool
== :: GroupDeclaration -> GroupDeclaration -> Bool
$c== :: GroupDeclaration -> GroupDeclaration -> Bool
Eq, Int -> GroupDeclaration -> ShowS
[GroupDeclaration] -> ShowS
GroupDeclaration -> String
(Int -> GroupDeclaration -> ShowS)
-> (GroupDeclaration -> String)
-> ([GroupDeclaration] -> ShowS)
-> Show GroupDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupDeclaration] -> ShowS
$cshowList :: [GroupDeclaration] -> ShowS
show :: GroupDeclaration -> String
$cshow :: GroupDeclaration -> String
showsPrec :: Int -> GroupDeclaration -> ShowS
$cshowsPrec :: Int -> GroupDeclaration -> ShowS
Show)

type GroupConstituentList = [GroupConstituent]

data GroupConstituent =
    GCName Name
  | GCChar CharacterLiteral
  deriving (GroupConstituent -> GroupConstituent -> Bool
(GroupConstituent -> GroupConstituent -> Bool)
-> (GroupConstituent -> GroupConstituent -> Bool)
-> Eq GroupConstituent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupConstituent -> GroupConstituent -> Bool
$c/= :: GroupConstituent -> GroupConstituent -> Bool
== :: GroupConstituent -> GroupConstituent -> Bool
$c== :: GroupConstituent -> GroupConstituent -> Bool
Eq, Int -> GroupConstituent -> ShowS
GroupConstituentList -> ShowS
GroupConstituent -> String
(Int -> GroupConstituent -> ShowS)
-> (GroupConstituent -> String)
-> (GroupConstituentList -> ShowS)
-> Show GroupConstituent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: GroupConstituentList -> ShowS
$cshowList :: GroupConstituentList -> ShowS
show :: GroupConstituent -> String
$cshow :: GroupConstituent -> String
showsPrec :: Int -> GroupConstituent -> ShowS
$cshowsPrec :: Int -> GroupConstituent -> ShowS
Show)

--------------------------------------------------------------------------------
--
--                                   -- 5 --
--
--                               Specifications
--
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- * 5.1 Attribute specification
{-
    attribute_specification ::=
      ATTRIBUTE attribute_designator OF entity_specification IS expression ;

    entity_specification ::=
      entity_name_list : entity_class

    entity_class ::=
        ENTITY     | ARCHITECTURE  | CONFIGURATION
      | PROCEDURE  | FUNCTION	   | PACKAGE
      | TYPE       | SUBTYPE	   | CONSTANT
      | SIGNAL     | VARIABLE      | COMPONENT
      | LABEL	   | LITERAL       | UNITS
      | GROUP	   | FILE

    entity_name_list ::=
	entity_designator { , entity_designator }
      | OTHERS
      | ALL

    entity_designator ::= entity_tag [ signature ]

    entity_tag ::= simple_name | character_literal | operator_symbol
-}

data AttributeSpecification = AttributeSpecification {
    AttributeSpecification -> Identifier
as_attribute_designator :: AttributeDesignator
  , AttributeSpecification -> EntitySpecification
as_entity_specification :: EntitySpecification
  , AttributeSpecification -> Expression
as_expression           :: Expression
  }
  deriving (AttributeSpecification -> AttributeSpecification -> Bool
(AttributeSpecification -> AttributeSpecification -> Bool)
-> (AttributeSpecification -> AttributeSpecification -> Bool)
-> Eq AttributeSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeSpecification -> AttributeSpecification -> Bool
$c/= :: AttributeSpecification -> AttributeSpecification -> Bool
== :: AttributeSpecification -> AttributeSpecification -> Bool
$c== :: AttributeSpecification -> AttributeSpecification -> Bool
Eq, Int -> AttributeSpecification -> ShowS
[AttributeSpecification] -> ShowS
AttributeSpecification -> String
(Int -> AttributeSpecification -> ShowS)
-> (AttributeSpecification -> String)
-> ([AttributeSpecification] -> ShowS)
-> Show AttributeSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeSpecification] -> ShowS
$cshowList :: [AttributeSpecification] -> ShowS
show :: AttributeSpecification -> String
$cshow :: AttributeSpecification -> String
showsPrec :: Int -> AttributeSpecification -> ShowS
$cshowsPrec :: Int -> AttributeSpecification -> ShowS
Show)

data EntitySpecification = EntitySpecification {
    EntitySpecification -> EntityNameList
es_entity_name_list     :: EntityNameList
  , EntitySpecification -> EntityClass
es_entity_class         :: EntityClass
  }
  deriving (EntitySpecification -> EntitySpecification -> Bool
(EntitySpecification -> EntitySpecification -> Bool)
-> (EntitySpecification -> EntitySpecification -> Bool)
-> Eq EntitySpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntitySpecification -> EntitySpecification -> Bool
$c/= :: EntitySpecification -> EntitySpecification -> Bool
== :: EntitySpecification -> EntitySpecification -> Bool
$c== :: EntitySpecification -> EntitySpecification -> Bool
Eq, Int -> EntitySpecification -> ShowS
[EntitySpecification] -> ShowS
EntitySpecification -> String
(Int -> EntitySpecification -> ShowS)
-> (EntitySpecification -> String)
-> ([EntitySpecification] -> ShowS)
-> Show EntitySpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntitySpecification] -> ShowS
$cshowList :: [EntitySpecification] -> ShowS
show :: EntitySpecification -> String
$cshow :: EntitySpecification -> String
showsPrec :: Int -> EntitySpecification -> ShowS
$cshowsPrec :: Int -> EntitySpecification -> ShowS
Show)

data EntityClass =
    ENTITY     | ARCHITECTURE  | CONFIGURATION
  | PROCEDURE  | FUNCTION      | PACKAGE
  | TYPE       | SUBTYPE       | CONSTANT
  | SIGNAL     | VARIABLE      | COMPONENT
  | LABEL      | LITERAL       | UNITS
  | GROUP      | FILE
  deriving (EntityClass -> EntityClass -> Bool
(EntityClass -> EntityClass -> Bool)
-> (EntityClass -> EntityClass -> Bool) -> Eq EntityClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityClass -> EntityClass -> Bool
$c/= :: EntityClass -> EntityClass -> Bool
== :: EntityClass -> EntityClass -> Bool
$c== :: EntityClass -> EntityClass -> Bool
Eq, Int -> EntityClass -> ShowS
[EntityClass] -> ShowS
EntityClass -> String
(Int -> EntityClass -> ShowS)
-> (EntityClass -> String)
-> ([EntityClass] -> ShowS)
-> Show EntityClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityClass] -> ShowS
$cshowList :: [EntityClass] -> ShowS
show :: EntityClass -> String
$cshow :: EntityClass -> String
showsPrec :: Int -> EntityClass -> ShowS
$cshowsPrec :: Int -> EntityClass -> ShowS
Show)

data EntityNameList =
    ENLDesignators [EntityDesignator]
  | ENLOthers
  | ENLAll
  deriving (EntityNameList -> EntityNameList -> Bool
(EntityNameList -> EntityNameList -> Bool)
-> (EntityNameList -> EntityNameList -> Bool) -> Eq EntityNameList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityNameList -> EntityNameList -> Bool
$c/= :: EntityNameList -> EntityNameList -> Bool
== :: EntityNameList -> EntityNameList -> Bool
$c== :: EntityNameList -> EntityNameList -> Bool
Eq, Int -> EntityNameList -> ShowS
[EntityNameList] -> ShowS
EntityNameList -> String
(Int -> EntityNameList -> ShowS)
-> (EntityNameList -> String)
-> ([EntityNameList] -> ShowS)
-> Show EntityNameList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityNameList] -> ShowS
$cshowList :: [EntityNameList] -> ShowS
show :: EntityNameList -> String
$cshow :: EntityNameList -> String
showsPrec :: Int -> EntityNameList -> ShowS
$cshowsPrec :: Int -> EntityNameList -> ShowS
Show)

data EntityDesignator = EntityDesignator {
    EntityDesignator -> EntityTag
ed_entity_tag :: EntityTag
  , EntityDesignator -> Maybe Signature
ed_signature  :: Maybe Signature
  }
  deriving (EntityDesignator -> EntityDesignator -> Bool
(EntityDesignator -> EntityDesignator -> Bool)
-> (EntityDesignator -> EntityDesignator -> Bool)
-> Eq EntityDesignator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityDesignator -> EntityDesignator -> Bool
$c/= :: EntityDesignator -> EntityDesignator -> Bool
== :: EntityDesignator -> EntityDesignator -> Bool
$c== :: EntityDesignator -> EntityDesignator -> Bool
Eq, Int -> EntityDesignator -> ShowS
[EntityDesignator] -> ShowS
EntityDesignator -> String
(Int -> EntityDesignator -> ShowS)
-> (EntityDesignator -> String)
-> ([EntityDesignator] -> ShowS)
-> Show EntityDesignator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityDesignator] -> ShowS
$cshowList :: [EntityDesignator] -> ShowS
show :: EntityDesignator -> String
$cshow :: EntityDesignator -> String
showsPrec :: Int -> EntityDesignator -> ShowS
$cshowsPrec :: Int -> EntityDesignator -> ShowS
Show)

data EntityTag =
    ETName SimpleName
  | ETChar CharacterLiteral
  | ETOp   OperatorSymbol
  deriving (EntityTag -> EntityTag -> Bool
(EntityTag -> EntityTag -> Bool)
-> (EntityTag -> EntityTag -> Bool) -> Eq EntityTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityTag -> EntityTag -> Bool
$c/= :: EntityTag -> EntityTag -> Bool
== :: EntityTag -> EntityTag -> Bool
$c== :: EntityTag -> EntityTag -> Bool
Eq, Int -> EntityTag -> ShowS
[EntityTag] -> ShowS
EntityTag -> String
(Int -> EntityTag -> ShowS)
-> (EntityTag -> String)
-> ([EntityTag] -> ShowS)
-> Show EntityTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityTag] -> ShowS
$cshowList :: [EntityTag] -> ShowS
show :: EntityTag -> String
$cshow :: EntityTag -> String
showsPrec :: Int -> EntityTag -> ShowS
$cshowsPrec :: Int -> EntityTag -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 5.2 Configuration specification
{-
    configuration_specification ::=
      FOR component_specification binding_indication ;

    component_specification ::=
      instantiation_list : component_name

    instantiation_list ::=
	instantiation_label { , instantiation_label }
      | OTHERS
      | ALL

-}

data ConfigurationSpecification = ConfigurationSpecification {
    ConfigurationSpecification -> ComponentSpecification
cs_component_specification :: ComponentSpecification
  , ConfigurationSpecification -> BindingIndication
cs_binding_indication      :: BindingIndication
  }
  deriving (ConfigurationSpecification -> ConfigurationSpecification -> Bool
(ConfigurationSpecification -> ConfigurationSpecification -> Bool)
-> (ConfigurationSpecification
    -> ConfigurationSpecification -> Bool)
-> Eq ConfigurationSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationSpecification -> ConfigurationSpecification -> Bool
$c/= :: ConfigurationSpecification -> ConfigurationSpecification -> Bool
== :: ConfigurationSpecification -> ConfigurationSpecification -> Bool
$c== :: ConfigurationSpecification -> ConfigurationSpecification -> Bool
Eq, Int -> ConfigurationSpecification -> ShowS
[ConfigurationSpecification] -> ShowS
ConfigurationSpecification -> String
(Int -> ConfigurationSpecification -> ShowS)
-> (ConfigurationSpecification -> String)
-> ([ConfigurationSpecification] -> ShowS)
-> Show ConfigurationSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationSpecification] -> ShowS
$cshowList :: [ConfigurationSpecification] -> ShowS
show :: ConfigurationSpecification -> String
$cshow :: ConfigurationSpecification -> String
showsPrec :: Int -> ConfigurationSpecification -> ShowS
$cshowsPrec :: Int -> ConfigurationSpecification -> ShowS
Show)

data ComponentSpecification = ComponentSpecification {
    ComponentSpecification -> InstantiationList
cs_instantiation_list      :: InstantiationList
  , ComponentSpecification -> Name
cs_component_name          :: Name
  }
  deriving (ComponentSpecification -> ComponentSpecification -> Bool
(ComponentSpecification -> ComponentSpecification -> Bool)
-> (ComponentSpecification -> ComponentSpecification -> Bool)
-> Eq ComponentSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentSpecification -> ComponentSpecification -> Bool
$c/= :: ComponentSpecification -> ComponentSpecification -> Bool
== :: ComponentSpecification -> ComponentSpecification -> Bool
$c== :: ComponentSpecification -> ComponentSpecification -> Bool
Eq, Int -> ComponentSpecification -> ShowS
[ComponentSpecification] -> ShowS
ComponentSpecification -> String
(Int -> ComponentSpecification -> ShowS)
-> (ComponentSpecification -> String)
-> ([ComponentSpecification] -> ShowS)
-> Show ComponentSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentSpecification] -> ShowS
$cshowList :: [ComponentSpecification] -> ShowS
show :: ComponentSpecification -> String
$cshow :: ComponentSpecification -> String
showsPrec :: Int -> ComponentSpecification -> ShowS
$cshowsPrec :: Int -> ComponentSpecification -> ShowS
Show)

data InstantiationList =
    ILLabels [Label]
  | ILOthers
  | ILAll
  deriving (InstantiationList -> InstantiationList -> Bool
(InstantiationList -> InstantiationList -> Bool)
-> (InstantiationList -> InstantiationList -> Bool)
-> Eq InstantiationList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstantiationList -> InstantiationList -> Bool
$c/= :: InstantiationList -> InstantiationList -> Bool
== :: InstantiationList -> InstantiationList -> Bool
$c== :: InstantiationList -> InstantiationList -> Bool
Eq, Int -> InstantiationList -> ShowS
[InstantiationList] -> ShowS
InstantiationList -> String
(Int -> InstantiationList -> ShowS)
-> (InstantiationList -> String)
-> ([InstantiationList] -> ShowS)
-> Show InstantiationList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstantiationList] -> ShowS
$cshowList :: [InstantiationList] -> ShowS
show :: InstantiationList -> String
$cshow :: InstantiationList -> String
showsPrec :: Int -> InstantiationList -> ShowS
$cshowsPrec :: Int -> InstantiationList -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 5.2.1 Binding indication
{-
    binding_indication ::=
      [ USE entity_aspect ]
      [ generic_map_aspect ]
      [ port_map_aspect ]
-}

data BindingIndication = BindingIndication {
    BindingIndication -> Maybe EntityAspect
bi_entity_aspect      :: Maybe EntityAspect
  , BindingIndication -> Maybe GenericMapAspect
bi_generic_map_aspect :: Maybe GenericMapAspect
  , BindingIndication -> Maybe PortMapAspect
bi_port_map_aspect    :: Maybe PortMapAspect
  }
  deriving (BindingIndication -> BindingIndication -> Bool
(BindingIndication -> BindingIndication -> Bool)
-> (BindingIndication -> BindingIndication -> Bool)
-> Eq BindingIndication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindingIndication -> BindingIndication -> Bool
$c/= :: BindingIndication -> BindingIndication -> Bool
== :: BindingIndication -> BindingIndication -> Bool
$c== :: BindingIndication -> BindingIndication -> Bool
Eq, Int -> BindingIndication -> ShowS
[BindingIndication] -> ShowS
BindingIndication -> String
(Int -> BindingIndication -> ShowS)
-> (BindingIndication -> String)
-> ([BindingIndication] -> ShowS)
-> Show BindingIndication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindingIndication] -> ShowS
$cshowList :: [BindingIndication] -> ShowS
show :: BindingIndication -> String
$cshow :: BindingIndication -> String
showsPrec :: Int -> BindingIndication -> ShowS
$cshowsPrec :: Int -> BindingIndication -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 5.2.1.1 Entity aspect
{-
    entity_aspect ::=
        ENTITY entity_name [ ( architecture_identifier) ]
      | CONFIGURATION configuration_name
      | OPEN
-}

data EntityAspect =
    EAEntity Name (Maybe Identifier)
  | EAConfig Name
  | EAOpen
  deriving (EntityAspect -> EntityAspect -> Bool
(EntityAspect -> EntityAspect -> Bool)
-> (EntityAspect -> EntityAspect -> Bool) -> Eq EntityAspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityAspect -> EntityAspect -> Bool
$c/= :: EntityAspect -> EntityAspect -> Bool
== :: EntityAspect -> EntityAspect -> Bool
$c== :: EntityAspect -> EntityAspect -> Bool
Eq, Int -> EntityAspect -> ShowS
[EntityAspect] -> ShowS
EntityAspect -> String
(Int -> EntityAspect -> ShowS)
-> (EntityAspect -> String)
-> ([EntityAspect] -> ShowS)
-> Show EntityAspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityAspect] -> ShowS
$cshowList :: [EntityAspect] -> ShowS
show :: EntityAspect -> String
$cshow :: EntityAspect -> String
showsPrec :: Int -> EntityAspect -> ShowS
$cshowsPrec :: Int -> EntityAspect -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 5.2.1.2 Generic map and port map aspects
{-
    generic_map_aspect ::=
      GENERIC MAP ( generic_association_list )

    port_map_aspect ::=
      PORT MAP ( port_association_list )
-}

data GenericMapAspect = GenericMapAspect AssociationList
  deriving (GenericMapAspect -> GenericMapAspect -> Bool
(GenericMapAspect -> GenericMapAspect -> Bool)
-> (GenericMapAspect -> GenericMapAspect -> Bool)
-> Eq GenericMapAspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericMapAspect -> GenericMapAspect -> Bool
$c/= :: GenericMapAspect -> GenericMapAspect -> Bool
== :: GenericMapAspect -> GenericMapAspect -> Bool
$c== :: GenericMapAspect -> GenericMapAspect -> Bool
Eq, Int -> GenericMapAspect -> ShowS
[GenericMapAspect] -> ShowS
GenericMapAspect -> String
(Int -> GenericMapAspect -> ShowS)
-> (GenericMapAspect -> String)
-> ([GenericMapAspect] -> ShowS)
-> Show GenericMapAspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericMapAspect] -> ShowS
$cshowList :: [GenericMapAspect] -> ShowS
show :: GenericMapAspect -> String
$cshow :: GenericMapAspect -> String
showsPrec :: Int -> GenericMapAspect -> ShowS
$cshowsPrec :: Int -> GenericMapAspect -> ShowS
Show)

data PortMapAspect    = PortMapAspect    AssociationList
  deriving (PortMapAspect -> PortMapAspect -> Bool
(PortMapAspect -> PortMapAspect -> Bool)
-> (PortMapAspect -> PortMapAspect -> Bool) -> Eq PortMapAspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortMapAspect -> PortMapAspect -> Bool
$c/= :: PortMapAspect -> PortMapAspect -> Bool
== :: PortMapAspect -> PortMapAspect -> Bool
$c== :: PortMapAspect -> PortMapAspect -> Bool
Eq, Int -> PortMapAspect -> ShowS
[PortMapAspect] -> ShowS
PortMapAspect -> String
(Int -> PortMapAspect -> ShowS)
-> (PortMapAspect -> String)
-> ([PortMapAspect] -> ShowS)
-> Show PortMapAspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortMapAspect] -> ShowS
$cshowList :: [PortMapAspect] -> ShowS
show :: PortMapAspect -> String
$cshow :: PortMapAspect -> String
showsPrec :: Int -> PortMapAspect -> ShowS
$cshowsPrec :: Int -> PortMapAspect -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 5.2.2 Default binding indication

-- defaults ... todo?

--------------------------------------------------------------------------------
-- * 5.3 Disconnection specification
{-
    disconnection_specification ::=
      DISCONNECT guarded_signal_specification AFTER time_expression ;

    guarded_signal_specification ::=
      guarded_signal_list : type_mark

    signal_list ::=
	signal_name { , signal_name }
      | OTHERS
      | ALL
-}

data DisconnectionSpecification = DisconnectionSpecification {
    DisconnectionSpecification -> GuardedSignalSpecification
ds_guarded_signal_specification :: GuardedSignalSpecification
  , DisconnectionSpecification -> Expression
ds_time_expression              :: Expression
  }
  deriving (DisconnectionSpecification -> DisconnectionSpecification -> Bool
(DisconnectionSpecification -> DisconnectionSpecification -> Bool)
-> (DisconnectionSpecification
    -> DisconnectionSpecification -> Bool)
-> Eq DisconnectionSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisconnectionSpecification -> DisconnectionSpecification -> Bool
$c/= :: DisconnectionSpecification -> DisconnectionSpecification -> Bool
== :: DisconnectionSpecification -> DisconnectionSpecification -> Bool
$c== :: DisconnectionSpecification -> DisconnectionSpecification -> Bool
Eq, Int -> DisconnectionSpecification -> ShowS
[DisconnectionSpecification] -> ShowS
DisconnectionSpecification -> String
(Int -> DisconnectionSpecification -> ShowS)
-> (DisconnectionSpecification -> String)
-> ([DisconnectionSpecification] -> ShowS)
-> Show DisconnectionSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisconnectionSpecification] -> ShowS
$cshowList :: [DisconnectionSpecification] -> ShowS
show :: DisconnectionSpecification -> String
$cshow :: DisconnectionSpecification -> String
showsPrec :: Int -> DisconnectionSpecification -> ShowS
$cshowsPrec :: Int -> DisconnectionSpecification -> ShowS
Show)

data GuardedSignalSpecification = GuardedSignalSpecification {
    GuardedSignalSpecification -> SignalList
gs_guarded_signal_list          :: SignalList
  , GuardedSignalSpecification -> TypeMark
gs_type_mark                    :: TypeMark
  }
  deriving (GuardedSignalSpecification -> GuardedSignalSpecification -> Bool
(GuardedSignalSpecification -> GuardedSignalSpecification -> Bool)
-> (GuardedSignalSpecification
    -> GuardedSignalSpecification -> Bool)
-> Eq GuardedSignalSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuardedSignalSpecification -> GuardedSignalSpecification -> Bool
$c/= :: GuardedSignalSpecification -> GuardedSignalSpecification -> Bool
== :: GuardedSignalSpecification -> GuardedSignalSpecification -> Bool
$c== :: GuardedSignalSpecification -> GuardedSignalSpecification -> Bool
Eq, Int -> GuardedSignalSpecification -> ShowS
[GuardedSignalSpecification] -> ShowS
GuardedSignalSpecification -> String
(Int -> GuardedSignalSpecification -> ShowS)
-> (GuardedSignalSpecification -> String)
-> ([GuardedSignalSpecification] -> ShowS)
-> Show GuardedSignalSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuardedSignalSpecification] -> ShowS
$cshowList :: [GuardedSignalSpecification] -> ShowS
show :: GuardedSignalSpecification -> String
$cshow :: GuardedSignalSpecification -> String
showsPrec :: Int -> GuardedSignalSpecification -> ShowS
$cshowsPrec :: Int -> GuardedSignalSpecification -> ShowS
Show)

data SignalList =
    SLName   [Name]
  | SLOthers
  | SLAll
  deriving (SignalList -> SignalList -> Bool
(SignalList -> SignalList -> Bool)
-> (SignalList -> SignalList -> Bool) -> Eq SignalList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalList -> SignalList -> Bool
$c/= :: SignalList -> SignalList -> Bool
== :: SignalList -> SignalList -> Bool
$c== :: SignalList -> SignalList -> Bool
Eq, Int -> SignalList -> ShowS
[SignalList] -> ShowS
SignalList -> String
(Int -> SignalList -> ShowS)
-> (SignalList -> String)
-> ([SignalList] -> ShowS)
-> Show SignalList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignalList] -> ShowS
$cshowList :: [SignalList] -> ShowS
show :: SignalList -> String
$cshow :: SignalList -> String
showsPrec :: Int -> SignalList -> ShowS
$cshowsPrec :: Int -> SignalList -> ShowS
Show)

--------------------------------------------------------------------------------
--
--                                   -- 6 --
--
--                                    Names
--
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- * 6.1 Names
{-
    name ::=
	simple_name
      | operator_symbol
      | selected_name
      | indexed_name
      | slice_name
      | attribute_name

    prefix ::=
        name
      | function_call
-}

data Name =
    NSimple SimpleName
  | NOp     OperatorSymbol
  | NSelect SelectedName
  | NIndex  IndexedName
  | NSlice  SliceName
  | NAttr   AttributeName
  deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)

data Prefix =
    PName Name
  | PFun  FunctionCall
  deriving (Prefix -> Prefix -> Bool
(Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool) -> Eq Prefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prefix -> Prefix -> Bool
$c/= :: Prefix -> Prefix -> Bool
== :: Prefix -> Prefix -> Bool
$c== :: Prefix -> Prefix -> Bool
Eq, Int -> Prefix -> ShowS
[Prefix] -> ShowS
Prefix -> String
(Int -> Prefix -> ShowS)
-> (Prefix -> String) -> ([Prefix] -> ShowS) -> Show Prefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prefix] -> ShowS
$cshowList :: [Prefix] -> ShowS
show :: Prefix -> String
$cshow :: Prefix -> String
showsPrec :: Int -> Prefix -> ShowS
$cshowsPrec :: Int -> Prefix -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 6.2 Simple names
{-
    simple_name ::= identifier
-}

type SimpleName = Identifier

--------------------------------------------------------------------------------
-- * 6.3 Selected names
{-
    selected_name ::= prefix . suffix

    suffix ::=
        simple_name
      | character_literal
      | operator_symbol
      | ALL
-}

data SelectedName = SelectedName {
    SelectedName -> Prefix
sname_prefix :: Prefix
  , SelectedName -> Suffix
sname_suffix :: Suffix
  }
  deriving (SelectedName -> SelectedName -> Bool
(SelectedName -> SelectedName -> Bool)
-> (SelectedName -> SelectedName -> Bool) -> Eq SelectedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectedName -> SelectedName -> Bool
$c/= :: SelectedName -> SelectedName -> Bool
== :: SelectedName -> SelectedName -> Bool
$c== :: SelectedName -> SelectedName -> Bool
Eq, Int -> SelectedName -> ShowS
[SelectedName] -> ShowS
SelectedName -> String
(Int -> SelectedName -> ShowS)
-> (SelectedName -> String)
-> ([SelectedName] -> ShowS)
-> Show SelectedName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectedName] -> ShowS
$cshowList :: [SelectedName] -> ShowS
show :: SelectedName -> String
$cshow :: SelectedName -> String
showsPrec :: Int -> SelectedName -> ShowS
$cshowsPrec :: Int -> SelectedName -> ShowS
Show)

data Suffix =
    SSimple SimpleName
  | SChar   CharacterLiteral
  | SOp     OperatorSymbol
  | SAll
  deriving (Suffix -> Suffix -> Bool
(Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool) -> Eq Suffix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Suffix -> Suffix -> Bool
$c/= :: Suffix -> Suffix -> Bool
== :: Suffix -> Suffix -> Bool
$c== :: Suffix -> Suffix -> Bool
Eq, Int -> Suffix -> ShowS
[Suffix] -> ShowS
Suffix -> String
(Int -> Suffix -> ShowS)
-> (Suffix -> String) -> ([Suffix] -> ShowS) -> Show Suffix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Suffix] -> ShowS
$cshowList :: [Suffix] -> ShowS
show :: Suffix -> String
$cshow :: Suffix -> String
showsPrec :: Int -> Suffix -> ShowS
$cshowsPrec :: Int -> Suffix -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 6.4 Indexed names
{-
    indexed_name ::= prefix ( expression { , expression } )
-}

data IndexedName = IndexedName {
    IndexedName -> Prefix
iname_prefix     :: Prefix
  , IndexedName -> [Expression]
iname_expression :: [Expression]
  }
  deriving (IndexedName -> IndexedName -> Bool
(IndexedName -> IndexedName -> Bool)
-> (IndexedName -> IndexedName -> Bool) -> Eq IndexedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexedName -> IndexedName -> Bool
$c/= :: IndexedName -> IndexedName -> Bool
== :: IndexedName -> IndexedName -> Bool
$c== :: IndexedName -> IndexedName -> Bool
Eq, Int -> IndexedName -> ShowS
[IndexedName] -> ShowS
IndexedName -> String
(Int -> IndexedName -> ShowS)
-> (IndexedName -> String)
-> ([IndexedName] -> ShowS)
-> Show IndexedName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexedName] -> ShowS
$cshowList :: [IndexedName] -> ShowS
show :: IndexedName -> String
$cshow :: IndexedName -> String
showsPrec :: Int -> IndexedName -> ShowS
$cshowsPrec :: Int -> IndexedName -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 6.5 Slice names
{-
    slice_name ::= prefix ( discrete_range )
-}

data SliceName = SliceName {
    SliceName -> Prefix
slice_prefix         :: Prefix
  , SliceName -> DiscreteRange
slice_discrete_range :: DiscreteRange
  }
  deriving (SliceName -> SliceName -> Bool
(SliceName -> SliceName -> Bool)
-> (SliceName -> SliceName -> Bool) -> Eq SliceName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SliceName -> SliceName -> Bool
$c/= :: SliceName -> SliceName -> Bool
== :: SliceName -> SliceName -> Bool
$c== :: SliceName -> SliceName -> Bool
Eq, Int -> SliceName -> ShowS
[SliceName] -> ShowS
SliceName -> String
(Int -> SliceName -> ShowS)
-> (SliceName -> String)
-> ([SliceName] -> ShowS)
-> Show SliceName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SliceName] -> ShowS
$cshowList :: [SliceName] -> ShowS
show :: SliceName -> String
$cshow :: SliceName -> String
showsPrec :: Int -> SliceName -> ShowS
$cshowsPrec :: Int -> SliceName -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 6.6 Attribute names
{-
    attribute_name ::=
      prefix [ signature ] ' attribute_designator [ ( expression ) ]

    attribute_designator ::= attribute_simple_name
-}

data AttributeName = AttributeName {
    AttributeName -> Prefix
aname_prefix               :: Prefix
  , AttributeName -> Maybe Signature
aname_signature            :: Maybe Signature
  , AttributeName -> Identifier
aname_attribute_designator :: AttributeDesignator
  , AttributeName -> Maybe Expression
aname_expression           :: Maybe Expression
  }
  deriving (AttributeName -> AttributeName -> Bool
(AttributeName -> AttributeName -> Bool)
-> (AttributeName -> AttributeName -> Bool) -> Eq AttributeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeName -> AttributeName -> Bool
$c/= :: AttributeName -> AttributeName -> Bool
== :: AttributeName -> AttributeName -> Bool
$c== :: AttributeName -> AttributeName -> Bool
Eq, Int -> AttributeName -> ShowS
[AttributeName] -> ShowS
AttributeName -> String
(Int -> AttributeName -> ShowS)
-> (AttributeName -> String)
-> ([AttributeName] -> ShowS)
-> Show AttributeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeName] -> ShowS
$cshowList :: [AttributeName] -> ShowS
show :: AttributeName -> String
$cshow :: AttributeName -> String
showsPrec :: Int -> AttributeName -> ShowS
$cshowsPrec :: Int -> AttributeName -> ShowS
Show)

type AttributeDesignator = SimpleName

--------------------------------------------------------------------------------
--
--                                   -- 7 --
--
--                                 Expression
--
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- * 7.1 Rules for expressions
{-
    expression ::=
	relation { AND relation }
      | relation { OR relation }
      | relation { XOR relation }
      | relation [ NAND relation ]
      | relation [ NOR relation ]
      | relation { XNOR relation }

    relation ::=
      shift_expression [ relational_operator shift_expression ]

    shift_expression ::=
      simple_expression [ shift_operator simple_expression ]

    simple_expression ::=
      [ sign ] term { adding_operator term }

    term ::=
      factor { multiplying_operator factor }

    factor ::=
	primary [ ** primary ]
      | ABS primary
      | NOT primary

    primary ::=
	name
      | literal
      | aggregate
      | function_call
      | qualified_expression
      | type_conversion
      | allocator
      | ( expression )
-}

data Expression =
    EAnd  [Relation]
  | EOr   [Relation]
  | EXor  [Relation]
  | ENand (Relation) (Maybe Relation)
  | ENor  (Relation) (Maybe Relation)
  | EXnor [Relation]
  deriving (Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c== :: Expression -> Expression -> Bool
Eq, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression] -> ShowS
$cshowList :: [Expression] -> ShowS
show :: Expression -> String
$cshow :: Expression -> String
showsPrec :: Int -> Expression -> ShowS
$cshowsPrec :: Int -> Expression -> ShowS
Show)

data Relation         = Relation {
    Relation -> ShiftExpression
relation_shift_expression :: ShiftExpression
  , Relation -> Maybe (RelationalOperator, ShiftExpression)
relation_operator         :: Maybe (RelationalOperator, ShiftExpression)
  }
  deriving (Relation -> Relation -> Bool
(Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool) -> Eq Relation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq, Int -> Relation -> ShowS
[Relation] -> ShowS
Relation -> String
(Int -> Relation -> ShowS)
-> (Relation -> String) -> ([Relation] -> ShowS) -> Show Relation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relation] -> ShowS
$cshowList :: [Relation] -> ShowS
show :: Relation -> String
$cshow :: Relation -> String
showsPrec :: Int -> Relation -> ShowS
$cshowsPrec :: Int -> Relation -> ShowS
Show)

data ShiftExpression  = ShiftExpression {
    ShiftExpression -> SimpleExpression
shifte_simple_expression  :: SimpleExpression
  , ShiftExpression -> Maybe (ShiftOperator, SimpleExpression)
shifte_shift_operator     :: Maybe (ShiftOperator, SimpleExpression)
  }
  deriving (ShiftExpression -> ShiftExpression -> Bool
(ShiftExpression -> ShiftExpression -> Bool)
-> (ShiftExpression -> ShiftExpression -> Bool)
-> Eq ShiftExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShiftExpression -> ShiftExpression -> Bool
$c/= :: ShiftExpression -> ShiftExpression -> Bool
== :: ShiftExpression -> ShiftExpression -> Bool
$c== :: ShiftExpression -> ShiftExpression -> Bool
Eq, Int -> ShiftExpression -> ShowS
[ShiftExpression] -> ShowS
ShiftExpression -> String
(Int -> ShiftExpression -> ShowS)
-> (ShiftExpression -> String)
-> ([ShiftExpression] -> ShowS)
-> Show ShiftExpression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShiftExpression] -> ShowS
$cshowList :: [ShiftExpression] -> ShowS
show :: ShiftExpression -> String
$cshow :: ShiftExpression -> String
showsPrec :: Int -> ShiftExpression -> ShowS
$cshowsPrec :: Int -> ShiftExpression -> ShowS
Show)

data SimpleExpression = SimpleExpression {
    SimpleExpression -> Maybe Sign
sexp_sign                 :: Maybe Sign
  , SimpleExpression -> Term
sexp_term                 :: Term
  , SimpleExpression -> [(AddingOperator, Term)]
sexp_adding               :: [(AddingOperator, Term)]
  }
  deriving (SimpleExpression -> SimpleExpression -> Bool
(SimpleExpression -> SimpleExpression -> Bool)
-> (SimpleExpression -> SimpleExpression -> Bool)
-> Eq SimpleExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleExpression -> SimpleExpression -> Bool
$c/= :: SimpleExpression -> SimpleExpression -> Bool
== :: SimpleExpression -> SimpleExpression -> Bool
$c== :: SimpleExpression -> SimpleExpression -> Bool
Eq, Int -> SimpleExpression -> ShowS
[SimpleExpression] -> ShowS
SimpleExpression -> String
(Int -> SimpleExpression -> ShowS)
-> (SimpleExpression -> String)
-> ([SimpleExpression] -> ShowS)
-> Show SimpleExpression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleExpression] -> ShowS
$cshowList :: [SimpleExpression] -> ShowS
show :: SimpleExpression -> String
$cshow :: SimpleExpression -> String
showsPrec :: Int -> SimpleExpression -> ShowS
$cshowsPrec :: Int -> SimpleExpression -> ShowS
Show)

data Term = Term {
    Term -> Factor
term_factor               :: Factor
  , Term -> [(MultiplyingOperator, Factor)]
term_multiplying          :: [(MultiplyingOperator, Factor)]
  }
  deriving (Term -> Term -> Bool
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c== :: Term -> Term -> Bool
Eq, Int -> Term -> ShowS
[Term] -> ShowS
Term -> String
(Int -> Term -> ShowS)
-> (Term -> String) -> ([Term] -> ShowS) -> Show Term
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Term] -> ShowS
$cshowList :: [Term] -> ShowS
show :: Term -> String
$cshow :: Term -> String
showsPrec :: Int -> Term -> ShowS
$cshowsPrec :: Int -> Term -> ShowS
Show)

data Factor =
    FacPrim Primary (Maybe Primary)
  | FacAbs  Primary
  | FacNot  Primary
  deriving (Factor -> Factor -> Bool
(Factor -> Factor -> Bool)
-> (Factor -> Factor -> Bool) -> Eq Factor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Factor -> Factor -> Bool
$c/= :: Factor -> Factor -> Bool
== :: Factor -> Factor -> Bool
$c== :: Factor -> Factor -> Bool
Eq, Int -> Factor -> ShowS
[Factor] -> ShowS
Factor -> String
(Int -> Factor -> ShowS)
-> (Factor -> String) -> ([Factor] -> ShowS) -> Show Factor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Factor] -> ShowS
$cshowList :: [Factor] -> ShowS
show :: Factor -> String
$cshow :: Factor -> String
showsPrec :: Int -> Factor -> ShowS
$cshowsPrec :: Int -> Factor -> ShowS
Show)

data Primary =
    PrimName  Name
  | PrimLit   Literal
  | PrimAgg   Aggregate
  | PrimFun   FunctionCall
  | PrimQual  QualifiedExpression
  | PrimTCon  TypeConversion
  | PrimAlloc Allocator
  | PrimExp   Expression
  deriving (Primary -> Primary -> Bool
(Primary -> Primary -> Bool)
-> (Primary -> Primary -> Bool) -> Eq Primary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Primary -> Primary -> Bool
$c/= :: Primary -> Primary -> Bool
== :: Primary -> Primary -> Bool
$c== :: Primary -> Primary -> Bool
Eq, Int -> Primary -> ShowS
[Primary] -> ShowS
Primary -> String
(Int -> Primary -> ShowS)
-> (Primary -> String) -> ([Primary] -> ShowS) -> Show Primary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Primary] -> ShowS
$cshowList :: [Primary] -> ShowS
show :: Primary -> String
$cshow :: Primary -> String
showsPrec :: Int -> Primary -> ShowS
$cshowsPrec :: Int -> Primary -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 7.2 Operators
{-
    logical_operator ::= AND | OR | NAND | NOR | XOR | XNOR

    relational_operator ::= = | /= | < | <= | > | >=

    shift_operator ::= SLL | SRL | SLA | SRA | ROL | ROR

    adding_operator ::= + | – | &

    sign ::= + | –

    multiplying_operator ::= * | / | MOD | REM

    miscellaneous_operator ::= ** | ABS | NOT
-}

data LogicalOperator       = And | Or | Nand | Nor | Xor | Xnor
  deriving (LogicalOperator -> LogicalOperator -> Bool
(LogicalOperator -> LogicalOperator -> Bool)
-> (LogicalOperator -> LogicalOperator -> Bool)
-> Eq LogicalOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicalOperator -> LogicalOperator -> Bool
$c/= :: LogicalOperator -> LogicalOperator -> Bool
== :: LogicalOperator -> LogicalOperator -> Bool
$c== :: LogicalOperator -> LogicalOperator -> Bool
Eq, Int -> LogicalOperator -> ShowS
[LogicalOperator] -> ShowS
LogicalOperator -> String
(Int -> LogicalOperator -> ShowS)
-> (LogicalOperator -> String)
-> ([LogicalOperator] -> ShowS)
-> Show LogicalOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogicalOperator] -> ShowS
$cshowList :: [LogicalOperator] -> ShowS
show :: LogicalOperator -> String
$cshow :: LogicalOperator -> String
showsPrec :: Int -> LogicalOperator -> ShowS
$cshowsPrec :: Int -> LogicalOperator -> ShowS
Show)

data RelationalOperator    = Eq | Neq | Lt | Lte | Gt | Gte
  deriving (RelationalOperator -> RelationalOperator -> Bool
(RelationalOperator -> RelationalOperator -> Bool)
-> (RelationalOperator -> RelationalOperator -> Bool)
-> Eq RelationalOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelationalOperator -> RelationalOperator -> Bool
$c/= :: RelationalOperator -> RelationalOperator -> Bool
== :: RelationalOperator -> RelationalOperator -> Bool
$c== :: RelationalOperator -> RelationalOperator -> Bool
Eq, Int -> RelationalOperator -> ShowS
[RelationalOperator] -> ShowS
RelationalOperator -> String
(Int -> RelationalOperator -> ShowS)
-> (RelationalOperator -> String)
-> ([RelationalOperator] -> ShowS)
-> Show RelationalOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelationalOperator] -> ShowS
$cshowList :: [RelationalOperator] -> ShowS
show :: RelationalOperator -> String
$cshow :: RelationalOperator -> String
showsPrec :: Int -> RelationalOperator -> ShowS
$cshowsPrec :: Int -> RelationalOperator -> ShowS
Show)

data ShiftOperator         = Sll | Srl | Sla | Sra | Rol | Ror
  deriving (ShiftOperator -> ShiftOperator -> Bool
(ShiftOperator -> ShiftOperator -> Bool)
-> (ShiftOperator -> ShiftOperator -> Bool) -> Eq ShiftOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShiftOperator -> ShiftOperator -> Bool
$c/= :: ShiftOperator -> ShiftOperator -> Bool
== :: ShiftOperator -> ShiftOperator -> Bool
$c== :: ShiftOperator -> ShiftOperator -> Bool
Eq, Int -> ShiftOperator -> ShowS
[ShiftOperator] -> ShowS
ShiftOperator -> String
(Int -> ShiftOperator -> ShowS)
-> (ShiftOperator -> String)
-> ([ShiftOperator] -> ShowS)
-> Show ShiftOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShiftOperator] -> ShowS
$cshowList :: [ShiftOperator] -> ShowS
show :: ShiftOperator -> String
$cshow :: ShiftOperator -> String
showsPrec :: Int -> ShiftOperator -> ShowS
$cshowsPrec :: Int -> ShiftOperator -> ShowS
Show)

data AddingOperator        = Plus | Minus | Concat
  deriving (AddingOperator -> AddingOperator -> Bool
(AddingOperator -> AddingOperator -> Bool)
-> (AddingOperator -> AddingOperator -> Bool) -> Eq AddingOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddingOperator -> AddingOperator -> Bool
$c/= :: AddingOperator -> AddingOperator -> Bool
== :: AddingOperator -> AddingOperator -> Bool
$c== :: AddingOperator -> AddingOperator -> Bool
Eq, Int -> AddingOperator -> ShowS
[AddingOperator] -> ShowS
AddingOperator -> String
(Int -> AddingOperator -> ShowS)
-> (AddingOperator -> String)
-> ([AddingOperator] -> ShowS)
-> Show AddingOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddingOperator] -> ShowS
$cshowList :: [AddingOperator] -> ShowS
show :: AddingOperator -> String
$cshow :: AddingOperator -> String
showsPrec :: Int -> AddingOperator -> ShowS
$cshowsPrec :: Int -> AddingOperator -> ShowS
Show)

data Sign                  = Identity | Negation
  deriving (Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c== :: Sign -> Sign -> Bool
Eq, Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show)

data MultiplyingOperator   = Times | Div | Mod | Rem
  deriving (MultiplyingOperator -> MultiplyingOperator -> Bool
(MultiplyingOperator -> MultiplyingOperator -> Bool)
-> (MultiplyingOperator -> MultiplyingOperator -> Bool)
-> Eq MultiplyingOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiplyingOperator -> MultiplyingOperator -> Bool
$c/= :: MultiplyingOperator -> MultiplyingOperator -> Bool
== :: MultiplyingOperator -> MultiplyingOperator -> Bool
$c== :: MultiplyingOperator -> MultiplyingOperator -> Bool
Eq, Int -> MultiplyingOperator -> ShowS
[MultiplyingOperator] -> ShowS
MultiplyingOperator -> String
(Int -> MultiplyingOperator -> ShowS)
-> (MultiplyingOperator -> String)
-> ([MultiplyingOperator] -> ShowS)
-> Show MultiplyingOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultiplyingOperator] -> ShowS
$cshowList :: [MultiplyingOperator] -> ShowS
show :: MultiplyingOperator -> String
$cshow :: MultiplyingOperator -> String
showsPrec :: Int -> MultiplyingOperator -> ShowS
$cshowsPrec :: Int -> MultiplyingOperator -> ShowS
Show)

data MiscellaneousOperator = Exp | Abs | Not
  deriving (MiscellaneousOperator -> MiscellaneousOperator -> Bool
(MiscellaneousOperator -> MiscellaneousOperator -> Bool)
-> (MiscellaneousOperator -> MiscellaneousOperator -> Bool)
-> Eq MiscellaneousOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MiscellaneousOperator -> MiscellaneousOperator -> Bool
$c/= :: MiscellaneousOperator -> MiscellaneousOperator -> Bool
== :: MiscellaneousOperator -> MiscellaneousOperator -> Bool
$c== :: MiscellaneousOperator -> MiscellaneousOperator -> Bool
Eq, Int -> MiscellaneousOperator -> ShowS
[MiscellaneousOperator] -> ShowS
MiscellaneousOperator -> String
(Int -> MiscellaneousOperator -> ShowS)
-> (MiscellaneousOperator -> String)
-> ([MiscellaneousOperator] -> ShowS)
-> Show MiscellaneousOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MiscellaneousOperator] -> ShowS
$cshowList :: [MiscellaneousOperator] -> ShowS
show :: MiscellaneousOperator -> String
$cshow :: MiscellaneousOperator -> String
showsPrec :: Int -> MiscellaneousOperator -> ShowS
$cshowsPrec :: Int -> MiscellaneousOperator -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 7.2.1 Logical operators

-- ...

--------------------------------------------------------------------------------
-- ** 7.2.2 Relational operators

-- ...

--------------------------------------------------------------------------------
-- ** 7.2.3 Shift operators

-- ...

--------------------------------------------------------------------------------
-- ** 7.2.4 Adding operators

-- ...

--------------------------------------------------------------------------------
-- ** 7.2.5 Sign operators

-- ...

--------------------------------------------------------------------------------
-- ** 7.2.6 Multiplying operators

-- ...

--------------------------------------------------------------------------------
-- ** 7.2.7 Miscellaneous operators

-- ...

--------------------------------------------------------------------------------
-- * 7.3 Operands

--------------------------------------------------------------------------------
-- ** 7.3.1 Literals
{-
    literal ::=
	numeric_literal
      | enumeration_literal
      | string_literal
      | bit_string_literal
      | NULL

    numeric_literal ::=
	abstract_literal
      | physical_literal
-}

data Literal =
    LitNum       NumericLiteral
  | LitEnum      EnumerationLiteral
  | LitString    StringLiteral
  | LitBitString BitStringLiteral
  | LitNull 
  deriving (Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq, Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
(Int -> Literal -> ShowS)
-> (Literal -> String) -> ([Literal] -> ShowS) -> Show Literal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Literal] -> ShowS
$cshowList :: [Literal] -> ShowS
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> ShowS
$cshowsPrec :: Int -> Literal -> ShowS
Show)

data NumericLiteral =
    NLitAbstract AbstractLiteral
  | NLitPhysical PhysicalLiteral
  deriving (NumericLiteral -> NumericLiteral -> Bool
(NumericLiteral -> NumericLiteral -> Bool)
-> (NumericLiteral -> NumericLiteral -> Bool) -> Eq NumericLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumericLiteral -> NumericLiteral -> Bool
$c/= :: NumericLiteral -> NumericLiteral -> Bool
== :: NumericLiteral -> NumericLiteral -> Bool
$c== :: NumericLiteral -> NumericLiteral -> Bool
Eq, Int -> NumericLiteral -> ShowS
[NumericLiteral] -> ShowS
NumericLiteral -> String
(Int -> NumericLiteral -> ShowS)
-> (NumericLiteral -> String)
-> ([NumericLiteral] -> ShowS)
-> Show NumericLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumericLiteral] -> ShowS
$cshowList :: [NumericLiteral] -> ShowS
show :: NumericLiteral -> String
$cshow :: NumericLiteral -> String
showsPrec :: Int -> NumericLiteral -> ShowS
$cshowsPrec :: Int -> NumericLiteral -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 7.3.2 Aggregates

{-
    aggregate ::=
      ( element_association { , element_association } )

    element_association ::=
      [ choices => ] expression

    choices ::= choice { | choice }

    choice ::=
        simple_expression
      | discrete_range
      | element_simple_name
      | OTHERS
-}

data Aggregate = Aggregate {
    Aggregate -> [ElementAssociation]
agg_element_association :: [ElementAssociation]
  }
  deriving (Aggregate -> Aggregate -> Bool
(Aggregate -> Aggregate -> Bool)
-> (Aggregate -> Aggregate -> Bool) -> Eq Aggregate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aggregate -> Aggregate -> Bool
$c/= :: Aggregate -> Aggregate -> Bool
== :: Aggregate -> Aggregate -> Bool
$c== :: Aggregate -> Aggregate -> Bool
Eq, Int -> Aggregate -> ShowS
[Aggregate] -> ShowS
Aggregate -> String
(Int -> Aggregate -> ShowS)
-> (Aggregate -> String)
-> ([Aggregate] -> ShowS)
-> Show Aggregate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Aggregate] -> ShowS
$cshowList :: [Aggregate] -> ShowS
show :: Aggregate -> String
$cshow :: Aggregate -> String
showsPrec :: Int -> Aggregate -> ShowS
$cshowsPrec :: Int -> Aggregate -> ShowS
Show)

data ElementAssociation = ElementAssociation {
    ElementAssociation -> Maybe Choices
eassoc_choices'   :: Maybe Choices
  , ElementAssociation -> Expression
eassoc_expression :: Expression
  }
  deriving (ElementAssociation -> ElementAssociation -> Bool
(ElementAssociation -> ElementAssociation -> Bool)
-> (ElementAssociation -> ElementAssociation -> Bool)
-> Eq ElementAssociation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementAssociation -> ElementAssociation -> Bool
$c/= :: ElementAssociation -> ElementAssociation -> Bool
== :: ElementAssociation -> ElementAssociation -> Bool
$c== :: ElementAssociation -> ElementAssociation -> Bool
Eq, Int -> ElementAssociation -> ShowS
[ElementAssociation] -> ShowS
ElementAssociation -> String
(Int -> ElementAssociation -> ShowS)
-> (ElementAssociation -> String)
-> ([ElementAssociation] -> ShowS)
-> Show ElementAssociation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElementAssociation] -> ShowS
$cshowList :: [ElementAssociation] -> ShowS
show :: ElementAssociation -> String
$cshow :: ElementAssociation -> String
showsPrec :: Int -> ElementAssociation -> ShowS
$cshowsPrec :: Int -> ElementAssociation -> ShowS
Show)

data Choices = Choices [Choice]
  deriving (Choices -> Choices -> Bool
(Choices -> Choices -> Bool)
-> (Choices -> Choices -> Bool) -> Eq Choices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Choices -> Choices -> Bool
$c/= :: Choices -> Choices -> Bool
== :: Choices -> Choices -> Bool
$c== :: Choices -> Choices -> Bool
Eq, Int -> Choices -> ShowS
[Choices] -> ShowS
Choices -> String
(Int -> Choices -> ShowS)
-> (Choices -> String) -> ([Choices] -> ShowS) -> Show Choices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Choices] -> ShowS
$cshowList :: [Choices] -> ShowS
show :: Choices -> String
$cshow :: Choices -> String
showsPrec :: Int -> Choices -> ShowS
$cshowsPrec :: Int -> Choices -> ShowS
Show)

data Choice =
    ChoiceSimple SimpleExpression
  | ChoiceRange  DiscreteRange
  | ChoiceName   SimpleName
  | ChoiceOthers
  deriving (Choice -> Choice -> Bool
(Choice -> Choice -> Bool)
-> (Choice -> Choice -> Bool) -> Eq Choice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Choice -> Choice -> Bool
$c/= :: Choice -> Choice -> Bool
== :: Choice -> Choice -> Bool
$c== :: Choice -> Choice -> Bool
Eq, Int -> Choice -> ShowS
[Choice] -> ShowS
Choice -> String
(Int -> Choice -> ShowS)
-> (Choice -> String) -> ([Choice] -> ShowS) -> Show Choice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Choice] -> ShowS
$cshowList :: [Choice] -> ShowS
show :: Choice -> String
$cshow :: Choice -> String
showsPrec :: Int -> Choice -> ShowS
$cshowsPrec :: Int -> Choice -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 7.3.2.1 Record aggregates

-- ...

--------------------------------------------------------------------------------
-- *** 7.3.2.2 Array aggregates

-- ...

--------------------------------------------------------------------------------
-- ** 7.3.3 Function calls
{-
    function_call ::=
      function_name [ ( actual_parameter_part ) ]

    actual_parameter_part ::= parameter_association_list
-}

data FunctionCall = FunctionCall {
    FunctionCall -> Name
fc_function_name         :: Name
  , FunctionCall -> Maybe AssociationList
fc_actual_parameter_part :: Maybe ActualParameterPart
  }
  deriving (FunctionCall -> FunctionCall -> Bool
(FunctionCall -> FunctionCall -> Bool)
-> (FunctionCall -> FunctionCall -> Bool) -> Eq FunctionCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionCall -> FunctionCall -> Bool
$c/= :: FunctionCall -> FunctionCall -> Bool
== :: FunctionCall -> FunctionCall -> Bool
$c== :: FunctionCall -> FunctionCall -> Bool
Eq, Int -> FunctionCall -> ShowS
[FunctionCall] -> ShowS
FunctionCall -> String
(Int -> FunctionCall -> ShowS)
-> (FunctionCall -> String)
-> ([FunctionCall] -> ShowS)
-> Show FunctionCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionCall] -> ShowS
$cshowList :: [FunctionCall] -> ShowS
show :: FunctionCall -> String
$cshow :: FunctionCall -> String
showsPrec :: Int -> FunctionCall -> ShowS
$cshowsPrec :: Int -> FunctionCall -> ShowS
Show)

type ActualParameterPart = AssociationList

--------------------------------------------------------------------------------
-- ** 7.3.4 Qualified expressions
{-
    qualified_expression ::=
	type_mark ' ( expression )
      | type_mark ' aggregate
-}

data QualifiedExpression =
    QualExp TypeMark Expression
  | QualAgg TypeMark Aggregate
  deriving (QualifiedExpression -> QualifiedExpression -> Bool
(QualifiedExpression -> QualifiedExpression -> Bool)
-> (QualifiedExpression -> QualifiedExpression -> Bool)
-> Eq QualifiedExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QualifiedExpression -> QualifiedExpression -> Bool
$c/= :: QualifiedExpression -> QualifiedExpression -> Bool
== :: QualifiedExpression -> QualifiedExpression -> Bool
$c== :: QualifiedExpression -> QualifiedExpression -> Bool
Eq, Int -> QualifiedExpression -> ShowS
[QualifiedExpression] -> ShowS
QualifiedExpression -> String
(Int -> QualifiedExpression -> ShowS)
-> (QualifiedExpression -> String)
-> ([QualifiedExpression] -> ShowS)
-> Show QualifiedExpression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualifiedExpression] -> ShowS
$cshowList :: [QualifiedExpression] -> ShowS
show :: QualifiedExpression -> String
$cshow :: QualifiedExpression -> String
showsPrec :: Int -> QualifiedExpression -> ShowS
$cshowsPrec :: Int -> QualifiedExpression -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 7.3.5 Type conversions
{-
    type_conversion ::= type_mark ( expression )
-}

data TypeConversion = TypeConversion {
    TypeConversion -> TypeMark
type_mark  :: TypeMark
  , TypeConversion -> Expression
expression :: Expression
  }
  deriving (TypeConversion -> TypeConversion -> Bool
(TypeConversion -> TypeConversion -> Bool)
-> (TypeConversion -> TypeConversion -> Bool) -> Eq TypeConversion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeConversion -> TypeConversion -> Bool
$c/= :: TypeConversion -> TypeConversion -> Bool
== :: TypeConversion -> TypeConversion -> Bool
$c== :: TypeConversion -> TypeConversion -> Bool
Eq, Int -> TypeConversion -> ShowS
[TypeConversion] -> ShowS
TypeConversion -> String
(Int -> TypeConversion -> ShowS)
-> (TypeConversion -> String)
-> ([TypeConversion] -> ShowS)
-> Show TypeConversion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeConversion] -> ShowS
$cshowList :: [TypeConversion] -> ShowS
show :: TypeConversion -> String
$cshow :: TypeConversion -> String
showsPrec :: Int -> TypeConversion -> ShowS
$cshowsPrec :: Int -> TypeConversion -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 7.3.6 Allocators
{-
    allocator ::=
	NEW subtype_indication
      | NEW qualified_expression
-}

data Allocator =
    AllocSub  SubtypeIndication
  | AllocQual QualifiedExpression
  deriving (Allocator -> Allocator -> Bool
(Allocator -> Allocator -> Bool)
-> (Allocator -> Allocator -> Bool) -> Eq Allocator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Allocator -> Allocator -> Bool
$c/= :: Allocator -> Allocator -> Bool
== :: Allocator -> Allocator -> Bool
$c== :: Allocator -> Allocator -> Bool
Eq, Int -> Allocator -> ShowS
[Allocator] -> ShowS
Allocator -> String
(Int -> Allocator -> ShowS)
-> (Allocator -> String)
-> ([Allocator] -> ShowS)
-> Show Allocator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Allocator] -> ShowS
$cshowList :: [Allocator] -> ShowS
show :: Allocator -> String
$cshow :: Allocator -> String
showsPrec :: Int -> Allocator -> ShowS
$cshowsPrec :: Int -> Allocator -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 7.4 Static expressions

--------------------------------------------------------------------------------
-- ** 7.4.1 Locally static primaries

-- ...

--------------------------------------------------------------------------------
-- ** 7.4.2 Globally static primaries

-- ...

--------------------------------------------------------------------------------
-- * 7.5 Universal expressions

-- ...


--------------------------------------------------------------------------------
--
--                                   -- 8 --
--
--                             Sequential statements
--
--------------------------------------------------------------------------------
{-
    sequence_of_statements ::= { sequential_statement }

    sequential_statement ::=
        wait_statement
      | assertion_statement
      | report_statement
      | signal_assignment_statement
      | variable_assignment_statement
      | procedure_call_statement
      | if_statement
      | case_statement
      | loop_statement
      | next_statement
      | exit_statement
      | return_statement
      | null_statement
-}

type SequenceOfStatements = [SequentialStatement]

data SequentialStatement =
    SWait      WaitStatement
  | SAssert    AssertionStatement
  | SReport    ReportStatement
  | SSignalAss SignalAssignmentStatement
  | SVarAss    VariableAssignmentStatement
  | SProc      ProcedureCallStatement
  | SIf        IfStatement
  | SCase      CaseStatement
  | SLoop      LoopStatement
  | SNext      NextStatement
  | SExit      ExitStatement
  | SReturn    ReturnStatement
  | SNull      NullStatement
  deriving (SequentialStatement -> SequentialStatement -> Bool
(SequentialStatement -> SequentialStatement -> Bool)
-> (SequentialStatement -> SequentialStatement -> Bool)
-> Eq SequentialStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SequentialStatement -> SequentialStatement -> Bool
$c/= :: SequentialStatement -> SequentialStatement -> Bool
== :: SequentialStatement -> SequentialStatement -> Bool
$c== :: SequentialStatement -> SequentialStatement -> Bool
Eq, Int -> SequentialStatement -> ShowS
SubprogramStatementPart -> ShowS
SequentialStatement -> String
(Int -> SequentialStatement -> ShowS)
-> (SequentialStatement -> String)
-> (SubprogramStatementPart -> ShowS)
-> Show SequentialStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: SubprogramStatementPart -> ShowS
$cshowList :: SubprogramStatementPart -> ShowS
show :: SequentialStatement -> String
$cshow :: SequentialStatement -> String
showsPrec :: Int -> SequentialStatement -> ShowS
$cshowsPrec :: Int -> SequentialStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.1 Wait statement
{-
    wait_statement ::=
      [ label : ] WAIT [ sensitivity_clause ] [ condition_clause ] [ timeout_clause ] ;

    sensitivity_clause ::= ON sensitivity_list

    sensitivity_list ::= signal_name { , signal_name }

    condition_clause ::= UNTIL condition

    condition ::= boolean_expression

    timeout_clause ::= FOR time_expression
-}

data WaitStatement = WaitStatement
    (Maybe Label) (Maybe SensitivityClause) (Maybe ConditionClause) (Maybe TimeoutClause)
  deriving (WaitStatement -> WaitStatement -> Bool
(WaitStatement -> WaitStatement -> Bool)
-> (WaitStatement -> WaitStatement -> Bool) -> Eq WaitStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WaitStatement -> WaitStatement -> Bool
$c/= :: WaitStatement -> WaitStatement -> Bool
== :: WaitStatement -> WaitStatement -> Bool
$c== :: WaitStatement -> WaitStatement -> Bool
Eq, Int -> WaitStatement -> ShowS
[WaitStatement] -> ShowS
WaitStatement -> String
(Int -> WaitStatement -> ShowS)
-> (WaitStatement -> String)
-> ([WaitStatement] -> ShowS)
-> Show WaitStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WaitStatement] -> ShowS
$cshowList :: [WaitStatement] -> ShowS
show :: WaitStatement -> String
$cshow :: WaitStatement -> String
showsPrec :: Int -> WaitStatement -> ShowS
$cshowsPrec :: Int -> WaitStatement -> ShowS
Show)

data SensitivityClause = SensitivityClause SensitivityList
  deriving (SensitivityClause -> SensitivityClause -> Bool
(SensitivityClause -> SensitivityClause -> Bool)
-> (SensitivityClause -> SensitivityClause -> Bool)
-> Eq SensitivityClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SensitivityClause -> SensitivityClause -> Bool
$c/= :: SensitivityClause -> SensitivityClause -> Bool
== :: SensitivityClause -> SensitivityClause -> Bool
$c== :: SensitivityClause -> SensitivityClause -> Bool
Eq, Int -> SensitivityClause -> ShowS
[SensitivityClause] -> ShowS
SensitivityClause -> String
(Int -> SensitivityClause -> ShowS)
-> (SensitivityClause -> String)
-> ([SensitivityClause] -> ShowS)
-> Show SensitivityClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SensitivityClause] -> ShowS
$cshowList :: [SensitivityClause] -> ShowS
show :: SensitivityClause -> String
$cshow :: SensitivityClause -> String
showsPrec :: Int -> SensitivityClause -> ShowS
$cshowsPrec :: Int -> SensitivityClause -> ShowS
Show)

data SensitivityList = SensitivityList [Name]
  deriving (SensitivityList -> SensitivityList -> Bool
(SensitivityList -> SensitivityList -> Bool)
-> (SensitivityList -> SensitivityList -> Bool)
-> Eq SensitivityList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SensitivityList -> SensitivityList -> Bool
$c/= :: SensitivityList -> SensitivityList -> Bool
== :: SensitivityList -> SensitivityList -> Bool
$c== :: SensitivityList -> SensitivityList -> Bool
Eq, Int -> SensitivityList -> ShowS
[SensitivityList] -> ShowS
SensitivityList -> String
(Int -> SensitivityList -> ShowS)
-> (SensitivityList -> String)
-> ([SensitivityList] -> ShowS)
-> Show SensitivityList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SensitivityList] -> ShowS
$cshowList :: [SensitivityList] -> ShowS
show :: SensitivityList -> String
$cshow :: SensitivityList -> String
showsPrec :: Int -> SensitivityList -> ShowS
$cshowsPrec :: Int -> SensitivityList -> ShowS
Show)

data ConditionClause = ConditionClause Condition
  deriving (ConditionClause -> ConditionClause -> Bool
(ConditionClause -> ConditionClause -> Bool)
-> (ConditionClause -> ConditionClause -> Bool)
-> Eq ConditionClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionClause -> ConditionClause -> Bool
$c/= :: ConditionClause -> ConditionClause -> Bool
== :: ConditionClause -> ConditionClause -> Bool
$c== :: ConditionClause -> ConditionClause -> Bool
Eq, Int -> ConditionClause -> ShowS
[ConditionClause] -> ShowS
ConditionClause -> String
(Int -> ConditionClause -> ShowS)
-> (ConditionClause -> String)
-> ([ConditionClause] -> ShowS)
-> Show ConditionClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConditionClause] -> ShowS
$cshowList :: [ConditionClause] -> ShowS
show :: ConditionClause -> String
$cshow :: ConditionClause -> String
showsPrec :: Int -> ConditionClause -> ShowS
$cshowsPrec :: Int -> ConditionClause -> ShowS
Show)

type Condition = Expression

data TimeoutClause = TimeoutClause Expression
  deriving (TimeoutClause -> TimeoutClause -> Bool
(TimeoutClause -> TimeoutClause -> Bool)
-> (TimeoutClause -> TimeoutClause -> Bool) -> Eq TimeoutClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeoutClause -> TimeoutClause -> Bool
$c/= :: TimeoutClause -> TimeoutClause -> Bool
== :: TimeoutClause -> TimeoutClause -> Bool
$c== :: TimeoutClause -> TimeoutClause -> Bool
Eq, Int -> TimeoutClause -> ShowS
[TimeoutClause] -> ShowS
TimeoutClause -> String
(Int -> TimeoutClause -> ShowS)
-> (TimeoutClause -> String)
-> ([TimeoutClause] -> ShowS)
-> Show TimeoutClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeoutClause] -> ShowS
$cshowList :: [TimeoutClause] -> ShowS
show :: TimeoutClause -> String
$cshow :: TimeoutClause -> String
showsPrec :: Int -> TimeoutClause -> ShowS
$cshowsPrec :: Int -> TimeoutClause -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.2 Assertion statement
{-
    assertion_statement ::= [ label : ] assertion ;

    assertion ::=
      ASSERT condition
        [ REPORT expression ]
        [ SEVERITY expression ]
-}

data AssertionStatement = AssertionStatement
      (Maybe Label) Assertion
  deriving (AssertionStatement -> AssertionStatement -> Bool
(AssertionStatement -> AssertionStatement -> Bool)
-> (AssertionStatement -> AssertionStatement -> Bool)
-> Eq AssertionStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionStatement -> AssertionStatement -> Bool
$c/= :: AssertionStatement -> AssertionStatement -> Bool
== :: AssertionStatement -> AssertionStatement -> Bool
$c== :: AssertionStatement -> AssertionStatement -> Bool
Eq, Int -> AssertionStatement -> ShowS
[AssertionStatement] -> ShowS
AssertionStatement -> String
(Int -> AssertionStatement -> ShowS)
-> (AssertionStatement -> String)
-> ([AssertionStatement] -> ShowS)
-> Show AssertionStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionStatement] -> ShowS
$cshowList :: [AssertionStatement] -> ShowS
show :: AssertionStatement -> String
$cshow :: AssertionStatement -> String
showsPrec :: Int -> AssertionStatement -> ShowS
$cshowsPrec :: Int -> AssertionStatement -> ShowS
Show)

data Assertion = Assertion
      Condition (Maybe Expression) (Maybe Expression)
  deriving (Assertion -> Assertion -> Bool
(Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Bool) -> Eq Assertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assertion -> Assertion -> Bool
$c/= :: Assertion -> Assertion -> Bool
== :: Assertion -> Assertion -> Bool
$c== :: Assertion -> Assertion -> Bool
Eq, Int -> Assertion -> ShowS
[Assertion] -> ShowS
Assertion -> String
(Int -> Assertion -> ShowS)
-> (Assertion -> String)
-> ([Assertion] -> ShowS)
-> Show Assertion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assertion] -> ShowS
$cshowList :: [Assertion] -> ShowS
show :: Assertion -> String
$cshow :: Assertion -> String
showsPrec :: Int -> Assertion -> ShowS
$cshowsPrec :: Int -> Assertion -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.3 Report statement
{-
    report_statement ::=
      [ label : ]
        REPORT expression
          [ SEVERITY expression ] ;
-}

data ReportStatement = ReportStatement
      (Maybe Label) Expression (Maybe Expression)
  deriving (ReportStatement -> ReportStatement -> Bool
(ReportStatement -> ReportStatement -> Bool)
-> (ReportStatement -> ReportStatement -> Bool)
-> Eq ReportStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportStatement -> ReportStatement -> Bool
$c/= :: ReportStatement -> ReportStatement -> Bool
== :: ReportStatement -> ReportStatement -> Bool
$c== :: ReportStatement -> ReportStatement -> Bool
Eq, Int -> ReportStatement -> ShowS
[ReportStatement] -> ShowS
ReportStatement -> String
(Int -> ReportStatement -> ShowS)
-> (ReportStatement -> String)
-> ([ReportStatement] -> ShowS)
-> Show ReportStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportStatement] -> ShowS
$cshowList :: [ReportStatement] -> ShowS
show :: ReportStatement -> String
$cshow :: ReportStatement -> String
showsPrec :: Int -> ReportStatement -> ShowS
$cshowsPrec :: Int -> ReportStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.4 Signal assignment statement
{-
    signal_assignment_statement ::=
      [ label : ] target <= [ delay_mechanism ] waveform ;

    delay_mechanism ::=
        TRANSPORT
      | [ REJECT time_expression ] INERTIAL

    target ::=
        name
      | aggregate

    waveform ::=
        waveform_element { , waveform_element }
      | UNAFFECTED
-}

data SignalAssignmentStatement = SignalAssignmentStatement
      (Maybe Label) Target (Maybe DelayMechanism) Waveform
  deriving (SignalAssignmentStatement -> SignalAssignmentStatement -> Bool
(SignalAssignmentStatement -> SignalAssignmentStatement -> Bool)
-> (SignalAssignmentStatement -> SignalAssignmentStatement -> Bool)
-> Eq SignalAssignmentStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalAssignmentStatement -> SignalAssignmentStatement -> Bool
$c/= :: SignalAssignmentStatement -> SignalAssignmentStatement -> Bool
== :: SignalAssignmentStatement -> SignalAssignmentStatement -> Bool
$c== :: SignalAssignmentStatement -> SignalAssignmentStatement -> Bool
Eq, Int -> SignalAssignmentStatement -> ShowS
[SignalAssignmentStatement] -> ShowS
SignalAssignmentStatement -> String
(Int -> SignalAssignmentStatement -> ShowS)
-> (SignalAssignmentStatement -> String)
-> ([SignalAssignmentStatement] -> ShowS)
-> Show SignalAssignmentStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignalAssignmentStatement] -> ShowS
$cshowList :: [SignalAssignmentStatement] -> ShowS
show :: SignalAssignmentStatement -> String
$cshow :: SignalAssignmentStatement -> String
showsPrec :: Int -> SignalAssignmentStatement -> ShowS
$cshowsPrec :: Int -> SignalAssignmentStatement -> ShowS
Show)

data DelayMechanism =
    DMechTransport
  | DMechInertial  (Maybe Expression)
  deriving (DelayMechanism -> DelayMechanism -> Bool
(DelayMechanism -> DelayMechanism -> Bool)
-> (DelayMechanism -> DelayMechanism -> Bool) -> Eq DelayMechanism
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DelayMechanism -> DelayMechanism -> Bool
$c/= :: DelayMechanism -> DelayMechanism -> Bool
== :: DelayMechanism -> DelayMechanism -> Bool
$c== :: DelayMechanism -> DelayMechanism -> Bool
Eq, Int -> DelayMechanism -> ShowS
[DelayMechanism] -> ShowS
DelayMechanism -> String
(Int -> DelayMechanism -> ShowS)
-> (DelayMechanism -> String)
-> ([DelayMechanism] -> ShowS)
-> Show DelayMechanism
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DelayMechanism] -> ShowS
$cshowList :: [DelayMechanism] -> ShowS
show :: DelayMechanism -> String
$cshow :: DelayMechanism -> String
showsPrec :: Int -> DelayMechanism -> ShowS
$cshowsPrec :: Int -> DelayMechanism -> ShowS
Show)

data Target = 
    TargetName Name
  | TargetAgg  Aggregate
  deriving (Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq, Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show)

data Waveform =
    WaveElem [WaveformElement]
  | WaveUnaffected
  deriving (Waveform -> Waveform -> Bool
(Waveform -> Waveform -> Bool)
-> (Waveform -> Waveform -> Bool) -> Eq Waveform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Waveform -> Waveform -> Bool
$c/= :: Waveform -> Waveform -> Bool
== :: Waveform -> Waveform -> Bool
$c== :: Waveform -> Waveform -> Bool
Eq, Int -> Waveform -> ShowS
[Waveform] -> ShowS
Waveform -> String
(Int -> Waveform -> ShowS)
-> (Waveform -> String) -> ([Waveform] -> ShowS) -> Show Waveform
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Waveform] -> ShowS
$cshowList :: [Waveform] -> ShowS
show :: Waveform -> String
$cshow :: Waveform -> String
showsPrec :: Int -> Waveform -> ShowS
$cshowsPrec :: Int -> Waveform -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 8.4.1 Updating a projected output waveform
{-
    waveform_element ::=
        value_expression [ AFTER time_expression ]
      | null [ AFTER time_expression ]
-}

data WaveformElement =
    WaveEExp  Expression (Maybe Expression)
  | WaveENull            (Maybe Expression)
  deriving (WaveformElement -> WaveformElement -> Bool
(WaveformElement -> WaveformElement -> Bool)
-> (WaveformElement -> WaveformElement -> Bool)
-> Eq WaveformElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WaveformElement -> WaveformElement -> Bool
$c/= :: WaveformElement -> WaveformElement -> Bool
== :: WaveformElement -> WaveformElement -> Bool
$c== :: WaveformElement -> WaveformElement -> Bool
Eq, Int -> WaveformElement -> ShowS
[WaveformElement] -> ShowS
WaveformElement -> String
(Int -> WaveformElement -> ShowS)
-> (WaveformElement -> String)
-> ([WaveformElement] -> ShowS)
-> Show WaveformElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WaveformElement] -> ShowS
$cshowList :: [WaveformElement] -> ShowS
show :: WaveformElement -> String
$cshow :: WaveformElement -> String
showsPrec :: Int -> WaveformElement -> ShowS
$cshowsPrec :: Int -> WaveformElement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.5 Variable assignment statement
{-
    variable_assignment_statement ::=
      [ label : ] target := expression ;
-}

data VariableAssignmentStatement = VariableAssignmentStatement
      (Maybe Label) Target Expression
  deriving (VariableAssignmentStatement -> VariableAssignmentStatement -> Bool
(VariableAssignmentStatement
 -> VariableAssignmentStatement -> Bool)
-> (VariableAssignmentStatement
    -> VariableAssignmentStatement -> Bool)
-> Eq VariableAssignmentStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariableAssignmentStatement -> VariableAssignmentStatement -> Bool
$c/= :: VariableAssignmentStatement -> VariableAssignmentStatement -> Bool
== :: VariableAssignmentStatement -> VariableAssignmentStatement -> Bool
$c== :: VariableAssignmentStatement -> VariableAssignmentStatement -> Bool
Eq, Int -> VariableAssignmentStatement -> ShowS
[VariableAssignmentStatement] -> ShowS
VariableAssignmentStatement -> String
(Int -> VariableAssignmentStatement -> ShowS)
-> (VariableAssignmentStatement -> String)
-> ([VariableAssignmentStatement] -> ShowS)
-> Show VariableAssignmentStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariableAssignmentStatement] -> ShowS
$cshowList :: [VariableAssignmentStatement] -> ShowS
show :: VariableAssignmentStatement -> String
$cshow :: VariableAssignmentStatement -> String
showsPrec :: Int -> VariableAssignmentStatement -> ShowS
$cshowsPrec :: Int -> VariableAssignmentStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 8.5.1 Array variable assignments

-- ...

--------------------------------------------------------------------------------
-- * 8.6 Procedure call statement
{-
    procedure_call_statement ::= [ label : ] procedure_call ;

    procedure_call ::= procedure_name [ ( actual_parameter_part ) ]
-}

data ProcedureCallStatement = ProcedureCallStatement
      (Maybe Label) ProcedureCall
  deriving (ProcedureCallStatement -> ProcedureCallStatement -> Bool
(ProcedureCallStatement -> ProcedureCallStatement -> Bool)
-> (ProcedureCallStatement -> ProcedureCallStatement -> Bool)
-> Eq ProcedureCallStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcedureCallStatement -> ProcedureCallStatement -> Bool
$c/= :: ProcedureCallStatement -> ProcedureCallStatement -> Bool
== :: ProcedureCallStatement -> ProcedureCallStatement -> Bool
$c== :: ProcedureCallStatement -> ProcedureCallStatement -> Bool
Eq, Int -> ProcedureCallStatement -> ShowS
[ProcedureCallStatement] -> ShowS
ProcedureCallStatement -> String
(Int -> ProcedureCallStatement -> ShowS)
-> (ProcedureCallStatement -> String)
-> ([ProcedureCallStatement] -> ShowS)
-> Show ProcedureCallStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcedureCallStatement] -> ShowS
$cshowList :: [ProcedureCallStatement] -> ShowS
show :: ProcedureCallStatement -> String
$cshow :: ProcedureCallStatement -> String
showsPrec :: Int -> ProcedureCallStatement -> ShowS
$cshowsPrec :: Int -> ProcedureCallStatement -> ShowS
Show)

data ProcedureCall = ProcedureCall
      Name (Maybe ActualParameterPart)
  deriving (ProcedureCall -> ProcedureCall -> Bool
(ProcedureCall -> ProcedureCall -> Bool)
-> (ProcedureCall -> ProcedureCall -> Bool) -> Eq ProcedureCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcedureCall -> ProcedureCall -> Bool
$c/= :: ProcedureCall -> ProcedureCall -> Bool
== :: ProcedureCall -> ProcedureCall -> Bool
$c== :: ProcedureCall -> ProcedureCall -> Bool
Eq, Int -> ProcedureCall -> ShowS
[ProcedureCall] -> ShowS
ProcedureCall -> String
(Int -> ProcedureCall -> ShowS)
-> (ProcedureCall -> String)
-> ([ProcedureCall] -> ShowS)
-> Show ProcedureCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcedureCall] -> ShowS
$cshowList :: [ProcedureCall] -> ShowS
show :: ProcedureCall -> String
$cshow :: ProcedureCall -> String
showsPrec :: Int -> ProcedureCall -> ShowS
$cshowsPrec :: Int -> ProcedureCall -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.7 If statement
{-
    if_statement ::=
      [ if_label : ]
        IF condition THEN
          sequence_of_statements
        { ELSEIF condition THEN
          sequence_of_statements }
        [ ELSE
          sequence_of_statements ]
        END IF [ if_label ] ;
-}

data IfStatement = IfStatement {
    IfStatement -> Maybe Identifier
if_label     :: Maybe Label
  , IfStatement -> (Expression, SubprogramStatementPart)
if_then      :: (Condition, SequenceOfStatements)
  , IfStatement -> [(Expression, SubprogramStatementPart)]
if_also      :: [(Condition, SequenceOfStatements)]
  , IfStatement -> Maybe SubprogramStatementPart
if_else      :: Maybe SequenceOfStatements
  }
  deriving (IfStatement -> IfStatement -> Bool
(IfStatement -> IfStatement -> Bool)
-> (IfStatement -> IfStatement -> Bool) -> Eq IfStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IfStatement -> IfStatement -> Bool
$c/= :: IfStatement -> IfStatement -> Bool
== :: IfStatement -> IfStatement -> Bool
$c== :: IfStatement -> IfStatement -> Bool
Eq, Int -> IfStatement -> ShowS
[IfStatement] -> ShowS
IfStatement -> String
(Int -> IfStatement -> ShowS)
-> (IfStatement -> String)
-> ([IfStatement] -> ShowS)
-> Show IfStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IfStatement] -> ShowS
$cshowList :: [IfStatement] -> ShowS
show :: IfStatement -> String
$cshow :: IfStatement -> String
showsPrec :: Int -> IfStatement -> ShowS
$cshowsPrec :: Int -> IfStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.8 Case statement
{-
    case_statement ::=
      [ case_label : ]
        CASE expression IS
          case_statement_alternative
          { case_statement_alternative }
        END CASE [ case_label ] ;

    case_statement_alternative ::=
      WHEN choices =>
        sequence_of_statements
-}

data CaseStatement = CaseStatement {
    CaseStatement -> Maybe Identifier
case_label        :: Maybe Label
  , CaseStatement -> Expression
case_expression   :: Expression
  , CaseStatement -> [CaseStatementAlternative]
case_alternatives :: [CaseStatementAlternative]
  }
  deriving (CaseStatement -> CaseStatement -> Bool
(CaseStatement -> CaseStatement -> Bool)
-> (CaseStatement -> CaseStatement -> Bool) -> Eq CaseStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseStatement -> CaseStatement -> Bool
$c/= :: CaseStatement -> CaseStatement -> Bool
== :: CaseStatement -> CaseStatement -> Bool
$c== :: CaseStatement -> CaseStatement -> Bool
Eq, Int -> CaseStatement -> ShowS
[CaseStatement] -> ShowS
CaseStatement -> String
(Int -> CaseStatement -> ShowS)
-> (CaseStatement -> String)
-> ([CaseStatement] -> ShowS)
-> Show CaseStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseStatement] -> ShowS
$cshowList :: [CaseStatement] -> ShowS
show :: CaseStatement -> String
$cshow :: CaseStatement -> String
showsPrec :: Int -> CaseStatement -> ShowS
$cshowsPrec :: Int -> CaseStatement -> ShowS
Show)

data CaseStatementAlternative = CaseStatementAlternative Choices SequenceOfStatements
  deriving (CaseStatementAlternative -> CaseStatementAlternative -> Bool
(CaseStatementAlternative -> CaseStatementAlternative -> Bool)
-> (CaseStatementAlternative -> CaseStatementAlternative -> Bool)
-> Eq CaseStatementAlternative
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseStatementAlternative -> CaseStatementAlternative -> Bool
$c/= :: CaseStatementAlternative -> CaseStatementAlternative -> Bool
== :: CaseStatementAlternative -> CaseStatementAlternative -> Bool
$c== :: CaseStatementAlternative -> CaseStatementAlternative -> Bool
Eq, Int -> CaseStatementAlternative -> ShowS
[CaseStatementAlternative] -> ShowS
CaseStatementAlternative -> String
(Int -> CaseStatementAlternative -> ShowS)
-> (CaseStatementAlternative -> String)
-> ([CaseStatementAlternative] -> ShowS)
-> Show CaseStatementAlternative
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseStatementAlternative] -> ShowS
$cshowList :: [CaseStatementAlternative] -> ShowS
show :: CaseStatementAlternative -> String
$cshow :: CaseStatementAlternative -> String
showsPrec :: Int -> CaseStatementAlternative -> ShowS
$cshowsPrec :: Int -> CaseStatementAlternative -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.9 Loop statement
{-
    loop_statement ::=
      [ loop_label : ]
        [ iteration_scheme ] LOOP
          sequence_of_statements
        END LOOP [ loop_label ] ;

    iteration_scheme ::=
        WHILE condition
      | FOR loop_parameter_specification

    parameter_specification ::=
      identifier IN discrete_range
-}

data LoopStatement = LoopStatement {
    LoopStatement -> Maybe Identifier
loop_label            :: Maybe Label
  , LoopStatement -> Maybe IterationScheme
loop_iteration_scheme :: Maybe IterationScheme
  , LoopStatement -> SubprogramStatementPart
loop_statements       :: SequenceOfStatements
  }
  deriving (LoopStatement -> LoopStatement -> Bool
(LoopStatement -> LoopStatement -> Bool)
-> (LoopStatement -> LoopStatement -> Bool) -> Eq LoopStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoopStatement -> LoopStatement -> Bool
$c/= :: LoopStatement -> LoopStatement -> Bool
== :: LoopStatement -> LoopStatement -> Bool
$c== :: LoopStatement -> LoopStatement -> Bool
Eq, Int -> LoopStatement -> ShowS
[LoopStatement] -> ShowS
LoopStatement -> String
(Int -> LoopStatement -> ShowS)
-> (LoopStatement -> String)
-> ([LoopStatement] -> ShowS)
-> Show LoopStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoopStatement] -> ShowS
$cshowList :: [LoopStatement] -> ShowS
show :: LoopStatement -> String
$cshow :: LoopStatement -> String
showsPrec :: Int -> LoopStatement -> ShowS
$cshowsPrec :: Int -> LoopStatement -> ShowS
Show)

data IterationScheme =
    IterWhile Condition
  | IterFor   ParameterSpecification
  deriving (IterationScheme -> IterationScheme -> Bool
(IterationScheme -> IterationScheme -> Bool)
-> (IterationScheme -> IterationScheme -> Bool)
-> Eq IterationScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IterationScheme -> IterationScheme -> Bool
$c/= :: IterationScheme -> IterationScheme -> Bool
== :: IterationScheme -> IterationScheme -> Bool
$c== :: IterationScheme -> IterationScheme -> Bool
Eq, Int -> IterationScheme -> ShowS
[IterationScheme] -> ShowS
IterationScheme -> String
(Int -> IterationScheme -> ShowS)
-> (IterationScheme -> String)
-> ([IterationScheme] -> ShowS)
-> Show IterationScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IterationScheme] -> ShowS
$cshowList :: [IterationScheme] -> ShowS
show :: IterationScheme -> String
$cshow :: IterationScheme -> String
showsPrec :: Int -> IterationScheme -> ShowS
$cshowsPrec :: Int -> IterationScheme -> ShowS
Show)

data ParameterSpecification = ParameterSpecification {
    ParameterSpecification -> Identifier
paramspec_identifier     :: Identifier
  , ParameterSpecification -> DiscreteRange
paramspec_discrete_range :: DiscreteRange
  }
  deriving (ParameterSpecification -> ParameterSpecification -> Bool
(ParameterSpecification -> ParameterSpecification -> Bool)
-> (ParameterSpecification -> ParameterSpecification -> Bool)
-> Eq ParameterSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterSpecification -> ParameterSpecification -> Bool
$c/= :: ParameterSpecification -> ParameterSpecification -> Bool
== :: ParameterSpecification -> ParameterSpecification -> Bool
$c== :: ParameterSpecification -> ParameterSpecification -> Bool
Eq, Int -> ParameterSpecification -> ShowS
[ParameterSpecification] -> ShowS
ParameterSpecification -> String
(Int -> ParameterSpecification -> ShowS)
-> (ParameterSpecification -> String)
-> ([ParameterSpecification] -> ShowS)
-> Show ParameterSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterSpecification] -> ShowS
$cshowList :: [ParameterSpecification] -> ShowS
show :: ParameterSpecification -> String
$cshow :: ParameterSpecification -> String
showsPrec :: Int -> ParameterSpecification -> ShowS
$cshowsPrec :: Int -> ParameterSpecification -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.10 Next statement
{-
    next_statement ::=
      [ label : ] NEXT [ loop_label ] [ WHEN condition ] ;
-}

data NextStatement = NextStatement {
    NextStatement -> Maybe Identifier
next_label :: Maybe Label
  , NextStatement -> Maybe Identifier
next_loop  :: Maybe Label
  , NextStatement -> Maybe Expression
next_when  :: Maybe Condition
  }
  deriving (NextStatement -> NextStatement -> Bool
(NextStatement -> NextStatement -> Bool)
-> (NextStatement -> NextStatement -> Bool) -> Eq NextStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NextStatement -> NextStatement -> Bool
$c/= :: NextStatement -> NextStatement -> Bool
== :: NextStatement -> NextStatement -> Bool
$c== :: NextStatement -> NextStatement -> Bool
Eq, Int -> NextStatement -> ShowS
[NextStatement] -> ShowS
NextStatement -> String
(Int -> NextStatement -> ShowS)
-> (NextStatement -> String)
-> ([NextStatement] -> ShowS)
-> Show NextStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextStatement] -> ShowS
$cshowList :: [NextStatement] -> ShowS
show :: NextStatement -> String
$cshow :: NextStatement -> String
showsPrec :: Int -> NextStatement -> ShowS
$cshowsPrec :: Int -> NextStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.11 Exit statement
{-
    exit_statement ::=
      [ label : ] EXIT [ loop_label ] [ WHEN condition ] ;
-}

data ExitStatement = ExitStatement {
    ExitStatement -> Maybe Identifier
exit_label :: Maybe Label
  , ExitStatement -> Maybe Identifier
exit_loop  :: Maybe Label
  , ExitStatement -> Maybe Expression
exit_when  :: Maybe Condition
  }
  deriving (ExitStatement -> ExitStatement -> Bool
(ExitStatement -> ExitStatement -> Bool)
-> (ExitStatement -> ExitStatement -> Bool) -> Eq ExitStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExitStatement -> ExitStatement -> Bool
$c/= :: ExitStatement -> ExitStatement -> Bool
== :: ExitStatement -> ExitStatement -> Bool
$c== :: ExitStatement -> ExitStatement -> Bool
Eq, Int -> ExitStatement -> ShowS
[ExitStatement] -> ShowS
ExitStatement -> String
(Int -> ExitStatement -> ShowS)
-> (ExitStatement -> String)
-> ([ExitStatement] -> ShowS)
-> Show ExitStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExitStatement] -> ShowS
$cshowList :: [ExitStatement] -> ShowS
show :: ExitStatement -> String
$cshow :: ExitStatement -> String
showsPrec :: Int -> ExitStatement -> ShowS
$cshowsPrec :: Int -> ExitStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.12 Return statement
{-
    return_statement ::=
      [ label : ] RETURN [ expression ] ;
-}

data ReturnStatement = ReturnStatement {
    ReturnStatement -> Maybe Identifier
return_label      :: Maybe Label
  , ReturnStatement -> Maybe Expression
return_expression :: Maybe Expression
  }
  deriving (ReturnStatement -> ReturnStatement -> Bool
(ReturnStatement -> ReturnStatement -> Bool)
-> (ReturnStatement -> ReturnStatement -> Bool)
-> Eq ReturnStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReturnStatement -> ReturnStatement -> Bool
$c/= :: ReturnStatement -> ReturnStatement -> Bool
== :: ReturnStatement -> ReturnStatement -> Bool
$c== :: ReturnStatement -> ReturnStatement -> Bool
Eq, Int -> ReturnStatement -> ShowS
[ReturnStatement] -> ShowS
ReturnStatement -> String
(Int -> ReturnStatement -> ShowS)
-> (ReturnStatement -> String)
-> ([ReturnStatement] -> ShowS)
-> Show ReturnStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReturnStatement] -> ShowS
$cshowList :: [ReturnStatement] -> ShowS
show :: ReturnStatement -> String
$cshow :: ReturnStatement -> String
showsPrec :: Int -> ReturnStatement -> ShowS
$cshowsPrec :: Int -> ReturnStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 8.13 Null statement
{-
    null_statement ::=
      [ label : ] NULL ;
-}

data NullStatement = NullStatement {
    NullStatement -> Maybe Identifier
null_label :: Maybe Label
  }
  deriving (NullStatement -> NullStatement -> Bool
(NullStatement -> NullStatement -> Bool)
-> (NullStatement -> NullStatement -> Bool) -> Eq NullStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NullStatement -> NullStatement -> Bool
$c/= :: NullStatement -> NullStatement -> Bool
== :: NullStatement -> NullStatement -> Bool
$c== :: NullStatement -> NullStatement -> Bool
Eq, Int -> NullStatement -> ShowS
[NullStatement] -> ShowS
NullStatement -> String
(Int -> NullStatement -> ShowS)
-> (NullStatement -> String)
-> ([NullStatement] -> ShowS)
-> Show NullStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NullStatement] -> ShowS
$cshowList :: [NullStatement] -> ShowS
show :: NullStatement -> String
$cshow :: NullStatement -> String
showsPrec :: Int -> NullStatement -> ShowS
$cshowsPrec :: Int -> NullStatement -> ShowS
Show)

--------------------------------------------------------------------------------
--
--                                   -- 9 --
--
--                            Concurrent statements
--
--------------------------------------------------------------------------------

{-
    concurrent_statement ::=
        block_statement
      | process_statement
      | concurrent_procedure_call_statement
      | concurrent_assertion_statement
      | concurrent_signal_assignment_statement
      | component_instantiation_statement
      | generate_statement
-}

data ConcurrentStatement =
    ConBlock     BlockStatement
  | ConProcess   ProcessStatement
  | ConProcCall  ConcurrentProcedureCallStatement
  | ConAssertion ConcurrentAssertionStatement
  | ConSignalAss ConcurrentSignalAssignmentStatement
  | ConComponent ComponentInstantiationStatement
  | ConGenerate  GenerateStatement
  deriving (ConcurrentStatement -> ConcurrentStatement -> Bool
(ConcurrentStatement -> ConcurrentStatement -> Bool)
-> (ConcurrentStatement -> ConcurrentStatement -> Bool)
-> Eq ConcurrentStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConcurrentStatement -> ConcurrentStatement -> Bool
$c/= :: ConcurrentStatement -> ConcurrentStatement -> Bool
== :: ConcurrentStatement -> ConcurrentStatement -> Bool
$c== :: ConcurrentStatement -> ConcurrentStatement -> Bool
Eq, Int -> ConcurrentStatement -> ShowS
ArchitectureStatementPart -> ShowS
ConcurrentStatement -> String
(Int -> ConcurrentStatement -> ShowS)
-> (ConcurrentStatement -> String)
-> (ArchitectureStatementPart -> ShowS)
-> Show ConcurrentStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: ArchitectureStatementPart -> ShowS
$cshowList :: ArchitectureStatementPart -> ShowS
show :: ConcurrentStatement -> String
$cshow :: ConcurrentStatement -> String
showsPrec :: Int -> ConcurrentStatement -> ShowS
$cshowsPrec :: Int -> ConcurrentStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 9.1 Block statement
{-
    block_statement ::=
      block_label :
        BLOCK [ ( guard_expression ) ] [ IS ]
          block_header
          block_declarative_part
        BEGIN
          block_statement_part
        END BLOCK [ block_label ] ;

    block_header ::=
      [ generic_clause
        [ generic_map_aspect ; ] ]
      [ port_clause
        [ port_map_aspect ; ] ]

    block_declarative_part ::=
      { block_declarative_item }

    block_statement_part ::=
      { concurrent_statement }
-}

data BlockStatement = BlockStatement {
    BlockStatement -> Identifier
blocks_label            :: Label
  , BlockStatement -> Maybe Expression
blocks_guard_expression :: Maybe Expression
  , BlockStatement -> BlockHeader
blocks_header           :: BlockHeader
  , BlockStatement -> ArchitectureDeclarativePart
blocks_declarative_part :: BlockDeclarativePart
  , BlockStatement -> ArchitectureStatementPart
blocks_statment_part    :: BlockStatementPart
  }
  deriving (BlockStatement -> BlockStatement -> Bool
(BlockStatement -> BlockStatement -> Bool)
-> (BlockStatement -> BlockStatement -> Bool) -> Eq BlockStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockStatement -> BlockStatement -> Bool
$c/= :: BlockStatement -> BlockStatement -> Bool
== :: BlockStatement -> BlockStatement -> Bool
$c== :: BlockStatement -> BlockStatement -> Bool
Eq, Int -> BlockStatement -> ShowS
[BlockStatement] -> ShowS
BlockStatement -> String
(Int -> BlockStatement -> ShowS)
-> (BlockStatement -> String)
-> ([BlockStatement] -> ShowS)
-> Show BlockStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockStatement] -> ShowS
$cshowList :: [BlockStatement] -> ShowS
show :: BlockStatement -> String
$cshow :: BlockStatement -> String
showsPrec :: Int -> BlockStatement -> ShowS
$cshowsPrec :: Int -> BlockStatement -> ShowS
Show)

data BlockHeader = BlockHeader {
    BlockHeader -> Maybe (GenericClause, Maybe GenericMapAspect)
blockh_generic_clause   :: Maybe (GenericClause, Maybe GenericMapAspect)
  , BlockHeader -> Maybe (PortClause, Maybe PortMapAspect)
blockh_port_clause      :: Maybe (PortClause,    Maybe PortMapAspect)
  }
  deriving (BlockHeader -> BlockHeader -> Bool
(BlockHeader -> BlockHeader -> Bool)
-> (BlockHeader -> BlockHeader -> Bool) -> Eq BlockHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockHeader -> BlockHeader -> Bool
$c/= :: BlockHeader -> BlockHeader -> Bool
== :: BlockHeader -> BlockHeader -> Bool
$c== :: BlockHeader -> BlockHeader -> Bool
Eq, Int -> BlockHeader -> ShowS
[BlockHeader] -> ShowS
BlockHeader -> String
(Int -> BlockHeader -> ShowS)
-> (BlockHeader -> String)
-> ([BlockHeader] -> ShowS)
-> Show BlockHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockHeader] -> ShowS
$cshowList :: [BlockHeader] -> ShowS
show :: BlockHeader -> String
$cshow :: BlockHeader -> String
showsPrec :: Int -> BlockHeader -> ShowS
$cshowsPrec :: Int -> BlockHeader -> ShowS
Show)

type BlockDeclarativePart = [BlockDeclarativeItem]

type BlockStatementPart   = [ConcurrentStatement]

--------------------------------------------------------------------------------
-- * 9.2 Process statement
{-
    process_statement ::=
      [ process_label : ]
        [ POSTPONED ] PROCESS [ ( sensitivity_list ) ] [ IS ]
          process_declarative_part
        BEGIN
          process_statement_part
        END [ POSTPONED ] PROCESS [ process_label ] ;

    process_declarative_part ::=
      { process_declarative_item }

    process_declarative_item ::=
        subprogram_declaration
      | subprogram_body
      | type_declaration
      | subtype_declaration
      | constant_declaration
      | variable_declaration
      | file_declaration
      | alias_declaration
      | attribute_declaration
      | attribute_specification
      | use_clause
      | group_type_declaration

    process_statement_part ::=
      { sequential_statement }
-}

data ProcessStatement = ProcessStatement {
    ProcessStatement -> Maybe Identifier
procs_label            :: Maybe Label
  , ProcessStatement -> Bool
procs_postponed        :: Bool
  , ProcessStatement -> Maybe SensitivityList
procs_sensitivity_list :: Maybe SensitivityList
  , ProcessStatement -> ProcessDeclarativePart
procs_declarative_part :: ProcessDeclarativePart
  , ProcessStatement -> SubprogramStatementPart
procs_statement_part   :: ProcessStatementPart
  }
  deriving (ProcessStatement -> ProcessStatement -> Bool
(ProcessStatement -> ProcessStatement -> Bool)
-> (ProcessStatement -> ProcessStatement -> Bool)
-> Eq ProcessStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessStatement -> ProcessStatement -> Bool
$c/= :: ProcessStatement -> ProcessStatement -> Bool
== :: ProcessStatement -> ProcessStatement -> Bool
$c== :: ProcessStatement -> ProcessStatement -> Bool
Eq, Int -> ProcessStatement -> ShowS
[ProcessStatement] -> ShowS
ProcessStatement -> String
(Int -> ProcessStatement -> ShowS)
-> (ProcessStatement -> String)
-> ([ProcessStatement] -> ShowS)
-> Show ProcessStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcessStatement] -> ShowS
$cshowList :: [ProcessStatement] -> ShowS
show :: ProcessStatement -> String
$cshow :: ProcessStatement -> String
showsPrec :: Int -> ProcessStatement -> ShowS
$cshowsPrec :: Int -> ProcessStatement -> ShowS
Show)

type ProcessDeclarativePart = [ProcessDeclarativeItem]

data ProcessDeclarativeItem =
    PDISubprogDecl SubprogramDeclaration
  | PDISubprogBody SubprogramBody
  | PDIType        TypeDeclaration
  | PDISubtype     SubtypeDeclaration
  | PDIConstant    ConstantDeclaration
  | PDIVariable    VariableDeclaration
  | PDIFile        FileDeclaration
  | PDIAlias       AliasDeclaration
  | PDIAttrDecl    AttributeDeclaration
  | PDIAttrSpec    AttributeSpecification
  | PDIUseClause   UseClause
--  | ProcDIGroupType   ()
  deriving (ProcessDeclarativeItem -> ProcessDeclarativeItem -> Bool
(ProcessDeclarativeItem -> ProcessDeclarativeItem -> Bool)
-> (ProcessDeclarativeItem -> ProcessDeclarativeItem -> Bool)
-> Eq ProcessDeclarativeItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessDeclarativeItem -> ProcessDeclarativeItem -> Bool
$c/= :: ProcessDeclarativeItem -> ProcessDeclarativeItem -> Bool
== :: ProcessDeclarativeItem -> ProcessDeclarativeItem -> Bool
$c== :: ProcessDeclarativeItem -> ProcessDeclarativeItem -> Bool
Eq, Int -> ProcessDeclarativeItem -> ShowS
ProcessDeclarativePart -> ShowS
ProcessDeclarativeItem -> String
(Int -> ProcessDeclarativeItem -> ShowS)
-> (ProcessDeclarativeItem -> String)
-> (ProcessDeclarativePart -> ShowS)
-> Show ProcessDeclarativeItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: ProcessDeclarativePart -> ShowS
$cshowList :: ProcessDeclarativePart -> ShowS
show :: ProcessDeclarativeItem -> String
$cshow :: ProcessDeclarativeItem -> String
showsPrec :: Int -> ProcessDeclarativeItem -> ShowS
$cshowsPrec :: Int -> ProcessDeclarativeItem -> ShowS
Show)

type ProcessStatementPart = [SequentialStatement]

--------------------------------------------------------------------------------
-- * 9.3 Concurrent procedure call statements
{-
    concurrent_procedure_call_statement ::=
      [ label : ] [ POSTPONED ] procedure_call ;
-}

data ConcurrentProcedureCallStatement = ConcurrentProcedureCallStatement {
    ConcurrentProcedureCallStatement -> Maybe Identifier
cpcs_label          :: Maybe Label
  , ConcurrentProcedureCallStatement -> Bool
cpcs_postponed      :: Bool
  , ConcurrentProcedureCallStatement -> ProcedureCall
cpcs_procedure_call :: ProcedureCall
  }
  deriving (ConcurrentProcedureCallStatement
-> ConcurrentProcedureCallStatement -> Bool
(ConcurrentProcedureCallStatement
 -> ConcurrentProcedureCallStatement -> Bool)
-> (ConcurrentProcedureCallStatement
    -> ConcurrentProcedureCallStatement -> Bool)
-> Eq ConcurrentProcedureCallStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConcurrentProcedureCallStatement
-> ConcurrentProcedureCallStatement -> Bool
$c/= :: ConcurrentProcedureCallStatement
-> ConcurrentProcedureCallStatement -> Bool
== :: ConcurrentProcedureCallStatement
-> ConcurrentProcedureCallStatement -> Bool
$c== :: ConcurrentProcedureCallStatement
-> ConcurrentProcedureCallStatement -> Bool
Eq, Int -> ConcurrentProcedureCallStatement -> ShowS
[ConcurrentProcedureCallStatement] -> ShowS
ConcurrentProcedureCallStatement -> String
(Int -> ConcurrentProcedureCallStatement -> ShowS)
-> (ConcurrentProcedureCallStatement -> String)
-> ([ConcurrentProcedureCallStatement] -> ShowS)
-> Show ConcurrentProcedureCallStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConcurrentProcedureCallStatement] -> ShowS
$cshowList :: [ConcurrentProcedureCallStatement] -> ShowS
show :: ConcurrentProcedureCallStatement -> String
$cshow :: ConcurrentProcedureCallStatement -> String
showsPrec :: Int -> ConcurrentProcedureCallStatement -> ShowS
$cshowsPrec :: Int -> ConcurrentProcedureCallStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 9.4 Concurrent assertion statements
{-
    concurrent_assertion_statement ::=
      [ label : ] [ POSTPONED ] assertion ;
-}

data ConcurrentAssertionStatement = ConcurrentAssertionStatement {
    ConcurrentAssertionStatement -> Maybe Identifier
cas_label          :: Maybe Label
  , ConcurrentAssertionStatement -> Bool
cas_postponed      :: Bool
  , ConcurrentAssertionStatement -> Assertion
cas_assertion      :: Assertion
  }
  deriving (ConcurrentAssertionStatement
-> ConcurrentAssertionStatement -> Bool
(ConcurrentAssertionStatement
 -> ConcurrentAssertionStatement -> Bool)
-> (ConcurrentAssertionStatement
    -> ConcurrentAssertionStatement -> Bool)
-> Eq ConcurrentAssertionStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConcurrentAssertionStatement
-> ConcurrentAssertionStatement -> Bool
$c/= :: ConcurrentAssertionStatement
-> ConcurrentAssertionStatement -> Bool
== :: ConcurrentAssertionStatement
-> ConcurrentAssertionStatement -> Bool
$c== :: ConcurrentAssertionStatement
-> ConcurrentAssertionStatement -> Bool
Eq, Int -> ConcurrentAssertionStatement -> ShowS
[ConcurrentAssertionStatement] -> ShowS
ConcurrentAssertionStatement -> String
(Int -> ConcurrentAssertionStatement -> ShowS)
-> (ConcurrentAssertionStatement -> String)
-> ([ConcurrentAssertionStatement] -> ShowS)
-> Show ConcurrentAssertionStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConcurrentAssertionStatement] -> ShowS
$cshowList :: [ConcurrentAssertionStatement] -> ShowS
show :: ConcurrentAssertionStatement -> String
$cshow :: ConcurrentAssertionStatement -> String
showsPrec :: Int -> ConcurrentAssertionStatement -> ShowS
$cshowsPrec :: Int -> ConcurrentAssertionStatement -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 9.5 Concurrent signal assignment statements
{-
    concurrent_signal_assignment_statement ::=
        [ label : ] [ POSTPONED ] conditional_signal_assignment
      | [ label : ] [ POSTPONED ] selected_signal_assignment

    options ::= [ GUARDED ] [ delay_mechanism ]
-}

data ConcurrentSignalAssignmentStatement =
    CSASCond {
      ConcurrentSignalAssignmentStatement -> Maybe Identifier
csas_cond_label               :: Maybe Label
    , ConcurrentSignalAssignmentStatement -> Bool
csas_cond_postponed           :: Bool
    , ConcurrentSignalAssignmentStatement -> ConditionalSignalAssignment
csas_cond_signal_assignment   :: ConditionalSignalAssignment
    }
  | CSASSelect {
      ConcurrentSignalAssignmentStatement -> Maybe Identifier
csas_select_label             :: Maybe Label
    , ConcurrentSignalAssignmentStatement -> Bool
csas_select_postponed         :: Bool
    , ConcurrentSignalAssignmentStatement -> SelectedSignalAssignment
csas_select_signal_assignment :: SelectedSignalAssignment
    }
  deriving (ConcurrentSignalAssignmentStatement
-> ConcurrentSignalAssignmentStatement -> Bool
(ConcurrentSignalAssignmentStatement
 -> ConcurrentSignalAssignmentStatement -> Bool)
-> (ConcurrentSignalAssignmentStatement
    -> ConcurrentSignalAssignmentStatement -> Bool)
-> Eq ConcurrentSignalAssignmentStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConcurrentSignalAssignmentStatement
-> ConcurrentSignalAssignmentStatement -> Bool
$c/= :: ConcurrentSignalAssignmentStatement
-> ConcurrentSignalAssignmentStatement -> Bool
== :: ConcurrentSignalAssignmentStatement
-> ConcurrentSignalAssignmentStatement -> Bool
$c== :: ConcurrentSignalAssignmentStatement
-> ConcurrentSignalAssignmentStatement -> Bool
Eq, Int -> ConcurrentSignalAssignmentStatement -> ShowS
[ConcurrentSignalAssignmentStatement] -> ShowS
ConcurrentSignalAssignmentStatement -> String
(Int -> ConcurrentSignalAssignmentStatement -> ShowS)
-> (ConcurrentSignalAssignmentStatement -> String)
-> ([ConcurrentSignalAssignmentStatement] -> ShowS)
-> Show ConcurrentSignalAssignmentStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConcurrentSignalAssignmentStatement] -> ShowS
$cshowList :: [ConcurrentSignalAssignmentStatement] -> ShowS
show :: ConcurrentSignalAssignmentStatement -> String
$cshow :: ConcurrentSignalAssignmentStatement -> String
showsPrec :: Int -> ConcurrentSignalAssignmentStatement -> ShowS
$cshowsPrec :: Int -> ConcurrentSignalAssignmentStatement -> ShowS
Show)

data Options = Options {
    Options -> Bool
options_guarded         :: Bool
  , Options -> Maybe DelayMechanism
options_delay_mechanism :: Maybe DelayMechanism
  }
  deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 9.5.1 Conditional signal assignments
{-
    conditional_signal_assignment ::=
      target <= options conditional_waveforms ;

    conditional_waveforms ::=
      { waveform WHEN condition ELSE }
      waveform [ WHEN condition ]
-}

data ConditionalSignalAssignment = ConditionalSignalAssignment {
    ConditionalSignalAssignment -> Target
csa_target                :: Target
  , ConditionalSignalAssignment -> Options
csa_options               :: Options
  , ConditionalSignalAssignment -> ConditionalWaveforms
csa_conditional_waveforms :: ConditionalWaveforms
  }
  deriving (ConditionalSignalAssignment -> ConditionalSignalAssignment -> Bool
(ConditionalSignalAssignment
 -> ConditionalSignalAssignment -> Bool)
-> (ConditionalSignalAssignment
    -> ConditionalSignalAssignment -> Bool)
-> Eq ConditionalSignalAssignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionalSignalAssignment -> ConditionalSignalAssignment -> Bool
$c/= :: ConditionalSignalAssignment -> ConditionalSignalAssignment -> Bool
== :: ConditionalSignalAssignment -> ConditionalSignalAssignment -> Bool
$c== :: ConditionalSignalAssignment -> ConditionalSignalAssignment -> Bool
Eq, Int -> ConditionalSignalAssignment -> ShowS
[ConditionalSignalAssignment] -> ShowS
ConditionalSignalAssignment -> String
(Int -> ConditionalSignalAssignment -> ShowS)
-> (ConditionalSignalAssignment -> String)
-> ([ConditionalSignalAssignment] -> ShowS)
-> Show ConditionalSignalAssignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConditionalSignalAssignment] -> ShowS
$cshowList :: [ConditionalSignalAssignment] -> ShowS
show :: ConditionalSignalAssignment -> String
$cshow :: ConditionalSignalAssignment -> String
showsPrec :: Int -> ConditionalSignalAssignment -> ShowS
$cshowsPrec :: Int -> ConditionalSignalAssignment -> ShowS
Show)

data ConditionalWaveforms = ConditionalWaveforms {
    ConditionalWaveforms -> [(Waveform, Expression)]
cw_optional              :: [(Waveform, Condition)]
  , ConditionalWaveforms -> (Waveform, Maybe Expression)
cw_wave                  :: (Waveform, Maybe Condition)
  }
  deriving (ConditionalWaveforms -> ConditionalWaveforms -> Bool
(ConditionalWaveforms -> ConditionalWaveforms -> Bool)
-> (ConditionalWaveforms -> ConditionalWaveforms -> Bool)
-> Eq ConditionalWaveforms
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionalWaveforms -> ConditionalWaveforms -> Bool
$c/= :: ConditionalWaveforms -> ConditionalWaveforms -> Bool
== :: ConditionalWaveforms -> ConditionalWaveforms -> Bool
$c== :: ConditionalWaveforms -> ConditionalWaveforms -> Bool
Eq, Int -> ConditionalWaveforms -> ShowS
[ConditionalWaveforms] -> ShowS
ConditionalWaveforms -> String
(Int -> ConditionalWaveforms -> ShowS)
-> (ConditionalWaveforms -> String)
-> ([ConditionalWaveforms] -> ShowS)
-> Show ConditionalWaveforms
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConditionalWaveforms] -> ShowS
$cshowList :: [ConditionalWaveforms] -> ShowS
show :: ConditionalWaveforms -> String
$cshow :: ConditionalWaveforms -> String
showsPrec :: Int -> ConditionalWaveforms -> ShowS
$cshowsPrec :: Int -> ConditionalWaveforms -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 9.5.2 Selected signal assignments
{-
    selected_signal_assignment ::=
      WITH expression SELECT
        target <= options selected_waveforms ;

    selected_waveforms ::=
      { waveform WHEN choices , }
      waveform WHEN choices
-}

data SelectedSignalAssignment = SelectedSignalAssignment {
    SelectedSignalAssignment -> Expression
ssa_expression         :: Expression
  , SelectedSignalAssignment -> Target
ssa_target             :: Target
  , SelectedSignalAssignment -> Options
ssa_options            :: Options
  , SelectedSignalAssignment -> SelectedWaveforms
ssa_selected_waveforms :: SelectedWaveforms
  }
  deriving (SelectedSignalAssignment -> SelectedSignalAssignment -> Bool
(SelectedSignalAssignment -> SelectedSignalAssignment -> Bool)
-> (SelectedSignalAssignment -> SelectedSignalAssignment -> Bool)
-> Eq SelectedSignalAssignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectedSignalAssignment -> SelectedSignalAssignment -> Bool
$c/= :: SelectedSignalAssignment -> SelectedSignalAssignment -> Bool
== :: SelectedSignalAssignment -> SelectedSignalAssignment -> Bool
$c== :: SelectedSignalAssignment -> SelectedSignalAssignment -> Bool
Eq, Int -> SelectedSignalAssignment -> ShowS
[SelectedSignalAssignment] -> ShowS
SelectedSignalAssignment -> String
(Int -> SelectedSignalAssignment -> ShowS)
-> (SelectedSignalAssignment -> String)
-> ([SelectedSignalAssignment] -> ShowS)
-> Show SelectedSignalAssignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectedSignalAssignment] -> ShowS
$cshowList :: [SelectedSignalAssignment] -> ShowS
show :: SelectedSignalAssignment -> String
$cshow :: SelectedSignalAssignment -> String
showsPrec :: Int -> SelectedSignalAssignment -> ShowS
$cshowsPrec :: Int -> SelectedSignalAssignment -> ShowS
Show)

data SelectedWaveforms = SelectedWaveforms {
    SelectedWaveforms -> Maybe [(Waveform, Choices)]
sw_optional :: Maybe [(Waveform, Choices)]
  , SelectedWaveforms -> (Waveform, Choices)
sw_last     :: (Waveform, Choices)
  }
  deriving (SelectedWaveforms -> SelectedWaveforms -> Bool
(SelectedWaveforms -> SelectedWaveforms -> Bool)
-> (SelectedWaveforms -> SelectedWaveforms -> Bool)
-> Eq SelectedWaveforms
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectedWaveforms -> SelectedWaveforms -> Bool
$c/= :: SelectedWaveforms -> SelectedWaveforms -> Bool
== :: SelectedWaveforms -> SelectedWaveforms -> Bool
$c== :: SelectedWaveforms -> SelectedWaveforms -> Bool
Eq, Int -> SelectedWaveforms -> ShowS
[SelectedWaveforms] -> ShowS
SelectedWaveforms -> String
(Int -> SelectedWaveforms -> ShowS)
-> (SelectedWaveforms -> String)
-> ([SelectedWaveforms] -> ShowS)
-> Show SelectedWaveforms
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectedWaveforms] -> ShowS
$cshowList :: [SelectedWaveforms] -> ShowS
show :: SelectedWaveforms -> String
$cshow :: SelectedWaveforms -> String
showsPrec :: Int -> SelectedWaveforms -> ShowS
$cshowsPrec :: Int -> SelectedWaveforms -> ShowS
Show)

--------------------------------------------------------------------------------
-- * 9.6 Component instantiation statements
{-
    component_instantiation_statement ::=
      instantiation_label :
        instantiated_unit
          [ generic_map_aspect ]
          [ port_map_aspect ] ;

    instantiated_unit ::=
        [ COMPONENT ] component_name
      | ENTITY entity_name [ ( architecture_identifier ) ]
      | CONFIGURATION configuration_name
-}

data ComponentInstantiationStatement = ComponentInstantiationStatement {
    ComponentInstantiationStatement -> Identifier
cis_instantiation_label :: Label
  , ComponentInstantiationStatement -> InstantiatedUnit
cis_instantiated_unit   :: InstantiatedUnit
  , ComponentInstantiationStatement -> Maybe GenericMapAspect
cis_generic_map_aspect  :: Maybe GenericMapAspect
  , ComponentInstantiationStatement -> Maybe PortMapAspect
cis_port_map_aspect     :: Maybe PortMapAspect
  }
  deriving (ComponentInstantiationStatement
-> ComponentInstantiationStatement -> Bool
(ComponentInstantiationStatement
 -> ComponentInstantiationStatement -> Bool)
-> (ComponentInstantiationStatement
    -> ComponentInstantiationStatement -> Bool)
-> Eq ComponentInstantiationStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentInstantiationStatement
-> ComponentInstantiationStatement -> Bool
$c/= :: ComponentInstantiationStatement
-> ComponentInstantiationStatement -> Bool
== :: ComponentInstantiationStatement
-> ComponentInstantiationStatement -> Bool
$c== :: ComponentInstantiationStatement
-> ComponentInstantiationStatement -> Bool
Eq, Int -> ComponentInstantiationStatement -> ShowS
[ComponentInstantiationStatement] -> ShowS
ComponentInstantiationStatement -> String
(Int -> ComponentInstantiationStatement -> ShowS)
-> (ComponentInstantiationStatement -> String)
-> ([ComponentInstantiationStatement] -> ShowS)
-> Show ComponentInstantiationStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentInstantiationStatement] -> ShowS
$cshowList :: [ComponentInstantiationStatement] -> ShowS
show :: ComponentInstantiationStatement -> String
$cshow :: ComponentInstantiationStatement -> String
showsPrec :: Int -> ComponentInstantiationStatement -> ShowS
$cshowsPrec :: Int -> ComponentInstantiationStatement -> ShowS
Show)

data InstantiatedUnit =
    IUComponent Name
  | IUEntity    Name (Maybe Identifier)
  | IUConfig    Name
  deriving (InstantiatedUnit -> InstantiatedUnit -> Bool
(InstantiatedUnit -> InstantiatedUnit -> Bool)
-> (InstantiatedUnit -> InstantiatedUnit -> Bool)
-> Eq InstantiatedUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstantiatedUnit -> InstantiatedUnit -> Bool
$c/= :: InstantiatedUnit -> InstantiatedUnit -> Bool
== :: InstantiatedUnit -> InstantiatedUnit -> Bool
$c== :: InstantiatedUnit -> InstantiatedUnit -> Bool
Eq, Int -> InstantiatedUnit -> ShowS
[InstantiatedUnit] -> ShowS
InstantiatedUnit -> String
(Int -> InstantiatedUnit -> ShowS)
-> (InstantiatedUnit -> String)
-> ([InstantiatedUnit] -> ShowS)
-> Show InstantiatedUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstantiatedUnit] -> ShowS
$cshowList :: [InstantiatedUnit] -> ShowS
show :: InstantiatedUnit -> String
$cshow :: InstantiatedUnit -> String
showsPrec :: Int -> InstantiatedUnit -> ShowS
$cshowsPrec :: Int -> InstantiatedUnit -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 9.6.1 Instantiation of a component

--------------------------------------------------------------------------------
-- ** 9.6.2 Instantiation of a design entity

--------------------------------------------------------------------------------
-- * 9.7 Generate statements
{-
    generate_statement ::=
      generate_label :
        generation_scheme GENERATE
          [ { block_declarative_item }
        BEGIN ]
          { concurrent_statement }
        END GENERATE [ generate_label ] ;

    generation_scheme ::=
        FOR generate_parameter_specification
      | IF condition

    label ::= identifier
-}

data GenerateStatement = GenerateStatement {
    GenerateStatement -> Identifier
gens_label                  :: Label
  , GenerateStatement -> GenerationScheme
gens_generation_scheme      :: GenerationScheme
  , GenerateStatement -> Maybe ArchitectureDeclarativePart
gens_block_declarative_item :: Maybe [BlockDeclarativeItem]
  , GenerateStatement -> ArchitectureStatementPart
gens_concurrent_statement   :: [ConcurrentStatement]
  }
  deriving (GenerateStatement -> GenerateStatement -> Bool
(GenerateStatement -> GenerateStatement -> Bool)
-> (GenerateStatement -> GenerateStatement -> Bool)
-> Eq GenerateStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenerateStatement -> GenerateStatement -> Bool
$c/= :: GenerateStatement -> GenerateStatement -> Bool
== :: GenerateStatement -> GenerateStatement -> Bool
$c== :: GenerateStatement -> GenerateStatement -> Bool
Eq, Int -> GenerateStatement -> ShowS
[GenerateStatement] -> ShowS
GenerateStatement -> String
(Int -> GenerateStatement -> ShowS)
-> (GenerateStatement -> String)
-> ([GenerateStatement] -> ShowS)
-> Show GenerateStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenerateStatement] -> ShowS
$cshowList :: [GenerateStatement] -> ShowS
show :: GenerateStatement -> String
$cshow :: GenerateStatement -> String
showsPrec :: Int -> GenerateStatement -> ShowS
$cshowsPrec :: Int -> GenerateStatement -> ShowS
Show)

data GenerationScheme =
    GSFor ParameterSpecification
  | GSIf Condition
  deriving (GenerationScheme -> GenerationScheme -> Bool
(GenerationScheme -> GenerationScheme -> Bool)
-> (GenerationScheme -> GenerationScheme -> Bool)
-> Eq GenerationScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenerationScheme -> GenerationScheme -> Bool
$c/= :: GenerationScheme -> GenerationScheme -> Bool
== :: GenerationScheme -> GenerationScheme -> Bool
$c== :: GenerationScheme -> GenerationScheme -> Bool
Eq, Int -> GenerationScheme -> ShowS
[GenerationScheme] -> ShowS
GenerationScheme -> String
(Int -> GenerationScheme -> ShowS)
-> (GenerationScheme -> String)
-> ([GenerationScheme] -> ShowS)
-> Show GenerationScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenerationScheme] -> ShowS
$cshowList :: [GenerationScheme] -> ShowS
show :: GenerationScheme -> String
$cshow :: GenerationScheme -> String
showsPrec :: Int -> GenerationScheme -> ShowS
$cshowsPrec :: Int -> GenerationScheme -> ShowS
Show)

type Label = Identifier
--------------------------------------------------------------------------------
--
--                                  -- 10 --
--
--                            Scope and visibility
--
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- ** 10.1 Declarative region

--------------------------------------------------------------------------------
-- ** 10.2 Scope of declarations

--------------------------------------------------------------------------------
-- ** 10.3 Visibility

--------------------------------------------------------------------------------
-- ** 10.4 Use clauses

{-
    use_clause ::=
      USE selected_name { , selected_name } ;
-}

data UseClause = UseClause [SelectedName]
  deriving (UseClause -> UseClause -> Bool
(UseClause -> UseClause -> Bool)
-> (UseClause -> UseClause -> Bool) -> Eq UseClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UseClause -> UseClause -> Bool
$c/= :: UseClause -> UseClause -> Bool
== :: UseClause -> UseClause -> Bool
$c== :: UseClause -> UseClause -> Bool
Eq, Int -> UseClause -> ShowS
[UseClause] -> ShowS
UseClause -> String
(Int -> UseClause -> ShowS)
-> (UseClause -> String)
-> ([UseClause] -> ShowS)
-> Show UseClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UseClause] -> ShowS
$cshowList :: [UseClause] -> ShowS
show :: UseClause -> String
$cshow :: UseClause -> String
showsPrec :: Int -> UseClause -> ShowS
$cshowsPrec :: Int -> UseClause -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 10.5 The context of overload resolution

--------------------------------------------------------------------------------
--
--                                  -- 11 --
--
--                        Design units and their analysis
--
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- ** 11.1 Design units

{-
    design_file ::= design_unit { design_unit }

    design_unit ::= context_clause library_unit

    library_unit ::=
        primary_unit
      | secondary_unit

    primary_unit ::=
        entity_declaration
      | configuration_declaration
      | package_declaration

    secondary_unit ::=
        architecture_body
      | package_body
-}

data DesignFile = DesignFile [DesignUnit]
  deriving (DesignFile -> DesignFile -> Bool
(DesignFile -> DesignFile -> Bool)
-> (DesignFile -> DesignFile -> Bool) -> Eq DesignFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DesignFile -> DesignFile -> Bool
$c/= :: DesignFile -> DesignFile -> Bool
== :: DesignFile -> DesignFile -> Bool
$c== :: DesignFile -> DesignFile -> Bool
Eq, Int -> DesignFile -> ShowS
[DesignFile] -> ShowS
DesignFile -> String
(Int -> DesignFile -> ShowS)
-> (DesignFile -> String)
-> ([DesignFile] -> ShowS)
-> Show DesignFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DesignFile] -> ShowS
$cshowList :: [DesignFile] -> ShowS
show :: DesignFile -> String
$cshow :: DesignFile -> String
showsPrec :: Int -> DesignFile -> ShowS
$cshowsPrec :: Int -> DesignFile -> ShowS
Show)

data DesignUnit = DesignUnit ContextClause LibraryUnit
  deriving (DesignUnit -> DesignUnit -> Bool
(DesignUnit -> DesignUnit -> Bool)
-> (DesignUnit -> DesignUnit -> Bool) -> Eq DesignUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DesignUnit -> DesignUnit -> Bool
$c/= :: DesignUnit -> DesignUnit -> Bool
== :: DesignUnit -> DesignUnit -> Bool
$c== :: DesignUnit -> DesignUnit -> Bool
Eq, Int -> DesignUnit -> ShowS
[DesignUnit] -> ShowS
DesignUnit -> String
(Int -> DesignUnit -> ShowS)
-> (DesignUnit -> String)
-> ([DesignUnit] -> ShowS)
-> Show DesignUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DesignUnit] -> ShowS
$cshowList :: [DesignUnit] -> ShowS
show :: DesignUnit -> String
$cshow :: DesignUnit -> String
showsPrec :: Int -> DesignUnit -> ShowS
$cshowsPrec :: Int -> DesignUnit -> ShowS
Show)

data LibraryUnit =
    LibraryPrimary   PrimaryUnit
  | LibrarySecondary SecondaryUnit
  deriving (LibraryUnit -> LibraryUnit -> Bool
(LibraryUnit -> LibraryUnit -> Bool)
-> (LibraryUnit -> LibraryUnit -> Bool) -> Eq LibraryUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LibraryUnit -> LibraryUnit -> Bool
$c/= :: LibraryUnit -> LibraryUnit -> Bool
== :: LibraryUnit -> LibraryUnit -> Bool
$c== :: LibraryUnit -> LibraryUnit -> Bool
Eq, Int -> LibraryUnit -> ShowS
[LibraryUnit] -> ShowS
LibraryUnit -> String
(Int -> LibraryUnit -> ShowS)
-> (LibraryUnit -> String)
-> ([LibraryUnit] -> ShowS)
-> Show LibraryUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LibraryUnit] -> ShowS
$cshowList :: [LibraryUnit] -> ShowS
show :: LibraryUnit -> String
$cshow :: LibraryUnit -> String
showsPrec :: Int -> LibraryUnit -> ShowS
$cshowsPrec :: Int -> LibraryUnit -> ShowS
Show)

data PrimaryUnit =
    PrimaryEntity  EntityDeclaration
  | PrimaryConfig  ConfigurationDeclaration
  | PrimaryPackage PackageDeclaration
  deriving (PrimaryUnit -> PrimaryUnit -> Bool
(PrimaryUnit -> PrimaryUnit -> Bool)
-> (PrimaryUnit -> PrimaryUnit -> Bool) -> Eq PrimaryUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimaryUnit -> PrimaryUnit -> Bool
$c/= :: PrimaryUnit -> PrimaryUnit -> Bool
== :: PrimaryUnit -> PrimaryUnit -> Bool
$c== :: PrimaryUnit -> PrimaryUnit -> Bool
Eq, Int -> PrimaryUnit -> ShowS
[PrimaryUnit] -> ShowS
PrimaryUnit -> String
(Int -> PrimaryUnit -> ShowS)
-> (PrimaryUnit -> String)
-> ([PrimaryUnit] -> ShowS)
-> Show PrimaryUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimaryUnit] -> ShowS
$cshowList :: [PrimaryUnit] -> ShowS
show :: PrimaryUnit -> String
$cshow :: PrimaryUnit -> String
showsPrec :: Int -> PrimaryUnit -> ShowS
$cshowsPrec :: Int -> PrimaryUnit -> ShowS
Show)

data SecondaryUnit =
    SecondaryArchitecture ArchitectureBody
  | SecondaryPackage      PackageBody
  deriving (SecondaryUnit -> SecondaryUnit -> Bool
(SecondaryUnit -> SecondaryUnit -> Bool)
-> (SecondaryUnit -> SecondaryUnit -> Bool) -> Eq SecondaryUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecondaryUnit -> SecondaryUnit -> Bool
$c/= :: SecondaryUnit -> SecondaryUnit -> Bool
== :: SecondaryUnit -> SecondaryUnit -> Bool
$c== :: SecondaryUnit -> SecondaryUnit -> Bool
Eq, Int -> SecondaryUnit -> ShowS
[SecondaryUnit] -> ShowS
SecondaryUnit -> String
(Int -> SecondaryUnit -> ShowS)
-> (SecondaryUnit -> String)
-> ([SecondaryUnit] -> ShowS)
-> Show SecondaryUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecondaryUnit] -> ShowS
$cshowList :: [SecondaryUnit] -> ShowS
show :: SecondaryUnit -> String
$cshow :: SecondaryUnit -> String
showsPrec :: Int -> SecondaryUnit -> ShowS
$cshowsPrec :: Int -> SecondaryUnit -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 11.2 Design libraries

{-
    library_clause ::= LIBRARY logical_name_list ;

    logical_name_list ::= logical_name { , logical_name }

    logical_name ::= identifier
-}

data LibraryClause = LibraryClause LogicalNameList
  deriving (LibraryClause -> LibraryClause -> Bool
(LibraryClause -> LibraryClause -> Bool)
-> (LibraryClause -> LibraryClause -> Bool) -> Eq LibraryClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LibraryClause -> LibraryClause -> Bool
$c/= :: LibraryClause -> LibraryClause -> Bool
== :: LibraryClause -> LibraryClause -> Bool
$c== :: LibraryClause -> LibraryClause -> Bool
Eq, Int -> LibraryClause -> ShowS
[LibraryClause] -> ShowS
LibraryClause -> String
(Int -> LibraryClause -> ShowS)
-> (LibraryClause -> String)
-> ([LibraryClause] -> ShowS)
-> Show LibraryClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LibraryClause] -> ShowS
$cshowList :: [LibraryClause] -> ShowS
show :: LibraryClause -> String
$cshow :: LibraryClause -> String
showsPrec :: Int -> LibraryClause -> ShowS
$cshowsPrec :: Int -> LibraryClause -> ShowS
Show)

data LogicalNameList = LogicalNameList [LogicalName]
  deriving (LogicalNameList -> LogicalNameList -> Bool
(LogicalNameList -> LogicalNameList -> Bool)
-> (LogicalNameList -> LogicalNameList -> Bool)
-> Eq LogicalNameList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicalNameList -> LogicalNameList -> Bool
$c/= :: LogicalNameList -> LogicalNameList -> Bool
== :: LogicalNameList -> LogicalNameList -> Bool
$c== :: LogicalNameList -> LogicalNameList -> Bool
Eq, Int -> LogicalNameList -> ShowS
[LogicalNameList] -> ShowS
LogicalNameList -> String
(Int -> LogicalNameList -> ShowS)
-> (LogicalNameList -> String)
-> ([LogicalNameList] -> ShowS)
-> Show LogicalNameList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogicalNameList] -> ShowS
$cshowList :: [LogicalNameList] -> ShowS
show :: LogicalNameList -> String
$cshow :: LogicalNameList -> String
showsPrec :: Int -> LogicalNameList -> ShowS
$cshowsPrec :: Int -> LogicalNameList -> ShowS
Show)

type LogicalName = Identifier

--------------------------------------------------------------------------------
-- ** 11.3 Context clauses

{-
    context_clause ::= { context_item }

    context_item ::=
        library_clause
      | use_clause
-}

data ContextClause = ContextClause [ContextItem]
  deriving (ContextClause -> ContextClause -> Bool
(ContextClause -> ContextClause -> Bool)
-> (ContextClause -> ContextClause -> Bool) -> Eq ContextClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextClause -> ContextClause -> Bool
$c/= :: ContextClause -> ContextClause -> Bool
== :: ContextClause -> ContextClause -> Bool
$c== :: ContextClause -> ContextClause -> Bool
Eq, Int -> ContextClause -> ShowS
[ContextClause] -> ShowS
ContextClause -> String
(Int -> ContextClause -> ShowS)
-> (ContextClause -> String)
-> ([ContextClause] -> ShowS)
-> Show ContextClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextClause] -> ShowS
$cshowList :: [ContextClause] -> ShowS
show :: ContextClause -> String
$cshow :: ContextClause -> String
showsPrec :: Int -> ContextClause -> ShowS
$cshowsPrec :: Int -> ContextClause -> ShowS
Show)

data ContextItem =
    ContextLibrary LibraryClause
  | ContextUse     UseClause
  deriving (ContextItem -> ContextItem -> Bool
(ContextItem -> ContextItem -> Bool)
-> (ContextItem -> ContextItem -> Bool) -> Eq ContextItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextItem -> ContextItem -> Bool
$c/= :: ContextItem -> ContextItem -> Bool
== :: ContextItem -> ContextItem -> Bool
$c== :: ContextItem -> ContextItem -> Bool
Eq, Int -> ContextItem -> ShowS
[ContextItem] -> ShowS
ContextItem -> String
(Int -> ContextItem -> ShowS)
-> (ContextItem -> String)
-> ([ContextItem] -> ShowS)
-> Show ContextItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextItem] -> ShowS
$cshowList :: [ContextItem] -> ShowS
show :: ContextItem -> String
$cshow :: ContextItem -> String
showsPrec :: Int -> ContextItem -> ShowS
$cshowsPrec :: Int -> ContextItem -> ShowS
Show)

--------------------------------------------------------------------------------
-- ** 11.3 Order of analysis

--------------------------------------------------------------------------------
--
--                                  -- 12 --
--
--                           Elaboration and execution
--
--------------------------------------------------------------------------------

-- ...

--------------------------------------------------------------------------------
--
--                                  -- 13 --
--
--                              Lexical elements
--
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- ** 13.4

{-
    abstract_literal ::= decimal_literal | based_literal
-}

data AbstractLiteral  =
      ALitDecimal DecimalLiteral
    | ALitBased   BasedLiteral
  deriving (AbstractLiteral -> AbstractLiteral -> Bool
(AbstractLiteral -> AbstractLiteral -> Bool)
-> (AbstractLiteral -> AbstractLiteral -> Bool)
-> Eq AbstractLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbstractLiteral -> AbstractLiteral -> Bool
$c/= :: AbstractLiteral -> AbstractLiteral -> Bool
== :: AbstractLiteral -> AbstractLiteral -> Bool
$c== :: AbstractLiteral -> AbstractLiteral -> Bool
Eq, Int -> AbstractLiteral -> ShowS
[AbstractLiteral] -> ShowS
AbstractLiteral -> String
(Int -> AbstractLiteral -> ShowS)
-> (AbstractLiteral -> String)
-> ([AbstractLiteral] -> ShowS)
-> Show AbstractLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbstractLiteral] -> ShowS
$cshowList :: [AbstractLiteral] -> ShowS
show :: AbstractLiteral -> String
$cshow :: AbstractLiteral -> String
showsPrec :: Int -> AbstractLiteral -> ShowS
$cshowsPrec :: Int -> AbstractLiteral -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 13.4.1
--
-- I use Haskell's Integer to represent integers in VHDL. Its syntax seems to be
-- slightly different though (the underline part).

{-
    decimal_literal ::= integer [ . integer ] [ exponent ]
    
    integer ::= digit { [ underline ] digit }

    exponent ::= E [ + ] integer | E – integer
-}

data DecimalLiteral = DecimalLiteral {
    DecimalLiteral -> Integer
decimal_integral_part   :: Integer
  , DecimalLiteral -> Maybe Integer
decimal_fractional_part :: Maybe Integer
  , DecimalLiteral -> Maybe Exponent
decimal_exponent        :: Maybe Exponent
  }
  deriving (DecimalLiteral -> DecimalLiteral -> Bool
(DecimalLiteral -> DecimalLiteral -> Bool)
-> (DecimalLiteral -> DecimalLiteral -> Bool) -> Eq DecimalLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecimalLiteral -> DecimalLiteral -> Bool
$c/= :: DecimalLiteral -> DecimalLiteral -> Bool
== :: DecimalLiteral -> DecimalLiteral -> Bool
$c== :: DecimalLiteral -> DecimalLiteral -> Bool
Eq, Int -> DecimalLiteral -> ShowS
[DecimalLiteral] -> ShowS
DecimalLiteral -> String
(Int -> DecimalLiteral -> ShowS)
-> (DecimalLiteral -> String)
-> ([DecimalLiteral] -> ShowS)
-> Show DecimalLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecimalLiteral] -> ShowS
$cshowList :: [DecimalLiteral] -> ShowS
show :: DecimalLiteral -> String
$cshow :: DecimalLiteral -> String
showsPrec :: Int -> DecimalLiteral -> ShowS
$cshowsPrec :: Int -> DecimalLiteral -> ShowS
Show)

data Exponent =
    ExponentPos Integer
  | ExponentNeg Integer
  deriving (Exponent -> Exponent -> Bool
(Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool) -> Eq Exponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exponent -> Exponent -> Bool
$c/= :: Exponent -> Exponent -> Bool
== :: Exponent -> Exponent -> Bool
$c== :: Exponent -> Exponent -> Bool
Eq, Int -> Exponent -> ShowS
[Exponent] -> ShowS
Exponent -> String
(Int -> Exponent -> ShowS)
-> (Exponent -> String) -> ([Exponent] -> ShowS) -> Show Exponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exponent] -> ShowS
$cshowList :: [Exponent] -> ShowS
show :: Exponent -> String
$cshow :: Exponent -> String
showsPrec :: Int -> Exponent -> ShowS
$cshowsPrec :: Int -> Exponent -> ShowS
Show)

--------------------------------------------------------------------------------
-- *** 13.4.2

{-
    based_literal ::=
      base # based_integer [ . based_integer ] # [ exponent ]

    base ::= integer

    based_integer ::=
      extended_digit { [ underline ] extended_digit }

    extended_digit ::= digit | letter
-}

data BasedLiteral = BasedLiteral {
    BasedLiteral -> Integer
based_lit_base                  :: Base
  , BasedLiteral -> Integer
based_lit_based_integral_part   :: BasedInteger
  , BasedLiteral -> Maybe Integer
based_lit_based_fractional_part :: Maybe BasedInteger
  , BasedLiteral -> Maybe Exponent
based_lit_exponent              :: Maybe Exponent
  }
  deriving (BasedLiteral -> BasedLiteral -> Bool
(BasedLiteral -> BasedLiteral -> Bool)
-> (BasedLiteral -> BasedLiteral -> Bool) -> Eq BasedLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasedLiteral -> BasedLiteral -> Bool
$c/= :: BasedLiteral -> BasedLiteral -> Bool
== :: BasedLiteral -> BasedLiteral -> Bool
$c== :: BasedLiteral -> BasedLiteral -> Bool
Eq, Int -> BasedLiteral -> ShowS
[BasedLiteral] -> ShowS
BasedLiteral -> String
(Int -> BasedLiteral -> ShowS)
-> (BasedLiteral -> String)
-> ([BasedLiteral] -> ShowS)
-> Show BasedLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BasedLiteral] -> ShowS
$cshowList :: [BasedLiteral] -> ShowS
show :: BasedLiteral -> String
$cshow :: BasedLiteral -> String
showsPrec :: Int -> BasedLiteral -> ShowS
$cshowsPrec :: Int -> BasedLiteral -> ShowS
Show)

type Base = Integer

type BasedInteger = Integer

type ExtendedDigit = Char

--------------------------------------------------------------------------------
-- *** 13.7 Bit string literals

{-
    bit_string_literal ::= base_specifier "[ bit_value ]"

    bit_value ::= extended_digit { [ underline ] extended_digit }

    base_specifier ::= B | O | X
-}

data BitStringLiteral = BitStringLiteral {
    BitStringLiteral -> BaseSpecifier
bsl_base_specifier :: BaseSpecifier
  , BitStringLiteral -> BitValue
bsl_bit_value :: BitValue
  }
  deriving (BitStringLiteral -> BitStringLiteral -> Bool
(BitStringLiteral -> BitStringLiteral -> Bool)
-> (BitStringLiteral -> BitStringLiteral -> Bool)
-> Eq BitStringLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitStringLiteral -> BitStringLiteral -> Bool
$c/= :: BitStringLiteral -> BitStringLiteral -> Bool
== :: BitStringLiteral -> BitStringLiteral -> Bool
$c== :: BitStringLiteral -> BitStringLiteral -> Bool
Eq, Int -> BitStringLiteral -> ShowS
[BitStringLiteral] -> ShowS
BitStringLiteral -> String
(Int -> BitStringLiteral -> ShowS)
-> (BitStringLiteral -> String)
-> ([BitStringLiteral] -> ShowS)
-> Show BitStringLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitStringLiteral] -> ShowS
$cshowList :: [BitStringLiteral] -> ShowS
show :: BitStringLiteral -> String
$cshow :: BitStringLiteral -> String
showsPrec :: Int -> BitStringLiteral -> ShowS
$cshowsPrec :: Int -> BitStringLiteral -> ShowS
Show)

data BitValue = BitValue [ExtendedDigit]
  deriving (BitValue -> BitValue -> Bool
(BitValue -> BitValue -> Bool)
-> (BitValue -> BitValue -> Bool) -> Eq BitValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitValue -> BitValue -> Bool
$c/= :: BitValue -> BitValue -> Bool
== :: BitValue -> BitValue -> Bool
$c== :: BitValue -> BitValue -> Bool
Eq, Int -> BitValue -> ShowS
[BitValue] -> ShowS
BitValue -> String
(Int -> BitValue -> ShowS)
-> (BitValue -> String) -> ([BitValue] -> ShowS) -> Show BitValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitValue] -> ShowS
$cshowList :: [BitValue] -> ShowS
show :: BitValue -> String
$cshow :: BitValue -> String
showsPrec :: Int -> BitValue -> ShowS
$cshowsPrec :: Int -> BitValue -> ShowS
Show)

data BaseSpecifier =
    BSOctal
  | BSBinary
  | BSHexadecimal
  deriving (BaseSpecifier -> BaseSpecifier -> Bool
(BaseSpecifier -> BaseSpecifier -> Bool)
-> (BaseSpecifier -> BaseSpecifier -> Bool) -> Eq BaseSpecifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseSpecifier -> BaseSpecifier -> Bool
$c/= :: BaseSpecifier -> BaseSpecifier -> Bool
== :: BaseSpecifier -> BaseSpecifier -> Bool
$c== :: BaseSpecifier -> BaseSpecifier -> Bool
Eq, Int -> BaseSpecifier -> ShowS
[BaseSpecifier] -> ShowS
BaseSpecifier -> String
(Int -> BaseSpecifier -> ShowS)
-> (BaseSpecifier -> String)
-> ([BaseSpecifier] -> ShowS)
-> Show BaseSpecifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseSpecifier] -> ShowS
$cshowList :: [BaseSpecifier] -> ShowS
show :: BaseSpecifier -> String
$cshow :: BaseSpecifier -> String
showsPrec :: Int -> BaseSpecifier -> ShowS
$cshowsPrec :: Int -> BaseSpecifier -> ShowS
Show)

--------------------------------------------------------------------------------
--
--                                  - ToDo -
--
--------------------------------------------------------------------------------

data Identifier       = Ident String
  deriving (Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c== :: Identifier -> Identifier -> Bool
Eq, Int -> Identifier -> ShowS
IdentifierList -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> (IdentifierList -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: IdentifierList -> ShowS
$cshowList :: IdentifierList -> ShowS
show :: Identifier -> String
$cshow :: Identifier -> String
showsPrec :: Int -> Identifier -> ShowS
$cshowsPrec :: Int -> Identifier -> ShowS
Show)

data CharacterLiteral = CLit Char
  deriving (CharacterLiteral -> CharacterLiteral -> Bool
(CharacterLiteral -> CharacterLiteral -> Bool)
-> (CharacterLiteral -> CharacterLiteral -> Bool)
-> Eq CharacterLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharacterLiteral -> CharacterLiteral -> Bool
$c/= :: CharacterLiteral -> CharacterLiteral -> Bool
== :: CharacterLiteral -> CharacterLiteral -> Bool
$c== :: CharacterLiteral -> CharacterLiteral -> Bool
Eq, Int -> CharacterLiteral -> ShowS
[CharacterLiteral] -> ShowS
CharacterLiteral -> String
(Int -> CharacterLiteral -> ShowS)
-> (CharacterLiteral -> String)
-> ([CharacterLiteral] -> ShowS)
-> Show CharacterLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharacterLiteral] -> ShowS
$cshowList :: [CharacterLiteral] -> ShowS
show :: CharacterLiteral -> String
$cshow :: CharacterLiteral -> String
showsPrec :: Int -> CharacterLiteral -> ShowS
$cshowsPrec :: Int -> CharacterLiteral -> ShowS
Show)

data StringLiteral    = SLit String
  deriving (StringLiteral -> StringLiteral -> Bool
(StringLiteral -> StringLiteral -> Bool)
-> (StringLiteral -> StringLiteral -> Bool) -> Eq StringLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringLiteral -> StringLiteral -> Bool
$c/= :: StringLiteral -> StringLiteral -> Bool
== :: StringLiteral -> StringLiteral -> Bool
$c== :: StringLiteral -> StringLiteral -> Bool
Eq, Int -> StringLiteral -> ShowS
[StringLiteral] -> ShowS
StringLiteral -> String
(Int -> StringLiteral -> ShowS)
-> (StringLiteral -> String)
-> ([StringLiteral] -> ShowS)
-> Show StringLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringLiteral] -> ShowS
$cshowList :: [StringLiteral] -> ShowS
show :: StringLiteral -> String
$cshow :: StringLiteral -> String
showsPrec :: Int -> StringLiteral -> ShowS
$cshowsPrec :: Int -> StringLiteral -> ShowS
Show)

--------------------------------------------------------------------------------

data BaseUnitDeclaration = BaseUnitDeclaration
  deriving (BaseUnitDeclaration -> BaseUnitDeclaration -> Bool
(BaseUnitDeclaration -> BaseUnitDeclaration -> Bool)
-> (BaseUnitDeclaration -> BaseUnitDeclaration -> Bool)
-> Eq BaseUnitDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseUnitDeclaration -> BaseUnitDeclaration -> Bool
$c/= :: BaseUnitDeclaration -> BaseUnitDeclaration -> Bool
== :: BaseUnitDeclaration -> BaseUnitDeclaration -> Bool
$c== :: BaseUnitDeclaration -> BaseUnitDeclaration -> Bool
Eq, Int -> BaseUnitDeclaration -> ShowS
[BaseUnitDeclaration] -> ShowS
BaseUnitDeclaration -> String
(Int -> BaseUnitDeclaration -> ShowS)
-> (BaseUnitDeclaration -> String)
-> ([BaseUnitDeclaration] -> ShowS)
-> Show BaseUnitDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseUnitDeclaration] -> ShowS
$cshowList :: [BaseUnitDeclaration] -> ShowS
show :: BaseUnitDeclaration -> String
$cshow :: BaseUnitDeclaration -> String
showsPrec :: Int -> BaseUnitDeclaration -> ShowS
$cshowsPrec :: Int -> BaseUnitDeclaration -> ShowS
Show)

data BasicCharacter = BasicCharacter
  deriving (BasicCharacter -> BasicCharacter -> Bool
(BasicCharacter -> BasicCharacter -> Bool)
-> (BasicCharacter -> BasicCharacter -> Bool) -> Eq BasicCharacter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasicCharacter -> BasicCharacter -> Bool
$c/= :: BasicCharacter -> BasicCharacter -> Bool
== :: BasicCharacter -> BasicCharacter -> Bool
$c== :: BasicCharacter -> BasicCharacter -> Bool
Eq, Int -> BasicCharacter -> ShowS
[BasicCharacter] -> ShowS
BasicCharacter -> String
(Int -> BasicCharacter -> ShowS)
-> (BasicCharacter -> String)
-> ([BasicCharacter] -> ShowS)
-> Show BasicCharacter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BasicCharacter] -> ShowS
$cshowList :: [BasicCharacter] -> ShowS
show :: BasicCharacter -> String
$cshow :: BasicCharacter -> String
showsPrec :: Int -> BasicCharacter -> ShowS
$cshowsPrec :: Int -> BasicCharacter -> ShowS
Show)

data BasicGraphicCharacter = BasicGraphicCharacter
  deriving (BasicGraphicCharacter -> BasicGraphicCharacter -> Bool
(BasicGraphicCharacter -> BasicGraphicCharacter -> Bool)
-> (BasicGraphicCharacter -> BasicGraphicCharacter -> Bool)
-> Eq BasicGraphicCharacter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasicGraphicCharacter -> BasicGraphicCharacter -> Bool
$c/= :: BasicGraphicCharacter -> BasicGraphicCharacter -> Bool
== :: BasicGraphicCharacter -> BasicGraphicCharacter -> Bool
$c== :: BasicGraphicCharacter -> BasicGraphicCharacter -> Bool
Eq, Int -> BasicGraphicCharacter -> ShowS
[BasicGraphicCharacter] -> ShowS
BasicGraphicCharacter -> String
(Int -> BasicGraphicCharacter -> ShowS)
-> (BasicGraphicCharacter -> String)
-> ([BasicGraphicCharacter] -> ShowS)
-> Show BasicGraphicCharacter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BasicGraphicCharacter] -> ShowS
$cshowList :: [BasicGraphicCharacter] -> ShowS
show :: BasicGraphicCharacter -> String
$cshow :: BasicGraphicCharacter -> String
showsPrec :: Int -> BasicGraphicCharacter -> ShowS
$cshowsPrec :: Int -> BasicGraphicCharacter -> ShowS
Show)

data BasicIdentifier = BasicIdentifier
  deriving (BasicIdentifier -> BasicIdentifier -> Bool
(BasicIdentifier -> BasicIdentifier -> Bool)
-> (BasicIdentifier -> BasicIdentifier -> Bool)
-> Eq BasicIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasicIdentifier -> BasicIdentifier -> Bool
$c/= :: BasicIdentifier -> BasicIdentifier -> Bool
== :: BasicIdentifier -> BasicIdentifier -> Bool
$c== :: BasicIdentifier -> BasicIdentifier -> Bool
Eq, Int -> BasicIdentifier -> ShowS
[BasicIdentifier] -> ShowS
BasicIdentifier -> String
(Int -> BasicIdentifier -> ShowS)
-> (BasicIdentifier -> String)
-> ([BasicIdentifier] -> ShowS)
-> Show BasicIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BasicIdentifier] -> ShowS
$cshowList :: [BasicIdentifier] -> ShowS
show :: BasicIdentifier -> String
$cshow :: BasicIdentifier -> String
showsPrec :: Int -> BasicIdentifier -> ShowS
$cshowsPrec :: Int -> BasicIdentifier -> ShowS
Show)

data ExtendedIdentifier = ExtendedIdentifier
  deriving (ExtendedIdentifier -> ExtendedIdentifier -> Bool
(ExtendedIdentifier -> ExtendedIdentifier -> Bool)
-> (ExtendedIdentifier -> ExtendedIdentifier -> Bool)
-> Eq ExtendedIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendedIdentifier -> ExtendedIdentifier -> Bool
$c/= :: ExtendedIdentifier -> ExtendedIdentifier -> Bool
== :: ExtendedIdentifier -> ExtendedIdentifier -> Bool
$c== :: ExtendedIdentifier -> ExtendedIdentifier -> Bool
Eq, Int -> ExtendedIdentifier -> ShowS
[ExtendedIdentifier] -> ShowS
ExtendedIdentifier -> String
(Int -> ExtendedIdentifier -> ShowS)
-> (ExtendedIdentifier -> String)
-> ([ExtendedIdentifier] -> ShowS)
-> Show ExtendedIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendedIdentifier] -> ShowS
$cshowList :: [ExtendedIdentifier] -> ShowS
show :: ExtendedIdentifier -> String
$cshow :: ExtendedIdentifier -> String
showsPrec :: Int -> ExtendedIdentifier -> ShowS
$cshowsPrec :: Int -> ExtendedIdentifier -> ShowS
Show)

data GraphicCharacter = GraphicCharacter
  deriving (GraphicCharacter -> GraphicCharacter -> Bool
(GraphicCharacter -> GraphicCharacter -> Bool)
-> (GraphicCharacter -> GraphicCharacter -> Bool)
-> Eq GraphicCharacter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphicCharacter -> GraphicCharacter -> Bool
$c/= :: GraphicCharacter -> GraphicCharacter -> Bool
== :: GraphicCharacter -> GraphicCharacter -> Bool
$c== :: GraphicCharacter -> GraphicCharacter -> Bool
Eq, Int -> GraphicCharacter -> ShowS
[GraphicCharacter] -> ShowS
GraphicCharacter -> String
(Int -> GraphicCharacter -> ShowS)
-> (GraphicCharacter -> String)
-> ([GraphicCharacter] -> ShowS)
-> Show GraphicCharacter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphicCharacter] -> ShowS
$cshowList :: [GraphicCharacter] -> ShowS
show :: GraphicCharacter -> String
$cshow :: GraphicCharacter -> String
showsPrec :: Int -> GraphicCharacter -> ShowS
$cshowsPrec :: Int -> GraphicCharacter -> ShowS
Show)

data Letter = Letter
  deriving (Letter -> Letter -> Bool
(Letter -> Letter -> Bool)
-> (Letter -> Letter -> Bool) -> Eq Letter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Letter -> Letter -> Bool
$c/= :: Letter -> Letter -> Bool
== :: Letter -> Letter -> Bool
$c== :: Letter -> Letter -> Bool
Eq, Int -> Letter -> ShowS
[Letter] -> ShowS
Letter -> String
(Int -> Letter -> ShowS)
-> (Letter -> String) -> ([Letter] -> ShowS) -> Show Letter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Letter] -> ShowS
$cshowList :: [Letter] -> ShowS
show :: Letter -> String
$cshow :: Letter -> String
showsPrec :: Int -> Letter -> ShowS
$cshowsPrec :: Int -> Letter -> ShowS
Show)

data LetterOrDigit = LetterOrDigit
  deriving (LetterOrDigit -> LetterOrDigit -> Bool
(LetterOrDigit -> LetterOrDigit -> Bool)
-> (LetterOrDigit -> LetterOrDigit -> Bool) -> Eq LetterOrDigit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LetterOrDigit -> LetterOrDigit -> Bool
$c/= :: LetterOrDigit -> LetterOrDigit -> Bool
== :: LetterOrDigit -> LetterOrDigit -> Bool
$c== :: LetterOrDigit -> LetterOrDigit -> Bool
Eq, Int -> LetterOrDigit -> ShowS
[LetterOrDigit] -> ShowS
LetterOrDigit -> String
(Int -> LetterOrDigit -> ShowS)
-> (LetterOrDigit -> String)
-> ([LetterOrDigit] -> ShowS)
-> Show LetterOrDigit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LetterOrDigit] -> ShowS
$cshowList :: [LetterOrDigit] -> ShowS
show :: LetterOrDigit -> String
$cshow :: LetterOrDigit -> String
showsPrec :: Int -> LetterOrDigit -> ShowS
$cshowsPrec :: Int -> LetterOrDigit -> ShowS
Show)

--------------------------------------------------------------------------------