{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances  #-}

module Language.VHDL.Pretty (Pretty (..)) where

import Language.VHDL.Syntax
import Text.PrettyPrint hiding (Mode)
import Prelude hiding ((<>))

--------------------------------------------------------------------------------
-- * Pretty printing class
--------------------------------------------------------------------------------

class Pretty a
  where
    pp :: a -> Doc

instance Pretty a => Pretty [a]
  where
    pp :: [a] -> Doc
pp = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pp

instance Pretty a => Pretty (Maybe a)
  where
    pp :: Maybe a -> Doc
pp = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty a -> Doc
forall a. Pretty a => a -> Doc
pp

--------------------------------------------------------------------------------
-- ** Pretty printing instances

instance Pretty AbstractLiteral where
  pp :: AbstractLiteral -> Doc
pp (ALitDecimal DecimalLiteral
d) = DecimalLiteral -> Doc
forall a. Pretty a => a -> Doc
pp DecimalLiteral
d
  pp (ALitBased   BasedLiteral
b) = BasedLiteral -> Doc
forall a. Pretty a => a -> Doc
pp BasedLiteral
b

instance Pretty AccessTypeDefinition where
  pp :: AccessTypeDefinition -> Doc
pp (AccessTypeDefinition SubtypeIndication
s) = String -> Doc
text String
"ACCESS" Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s

instance Pretty ActualDesignator where
  pp :: ActualDesignator -> Doc
pp (ADExpression Expression
e) = Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e
  pp (ADSignal Name
n)     = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (ADVariable Name
n)   = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (ADFile Name
n)       = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (ActualDesignator
ADOpen)         = String -> Doc
text String
"OPEN"

--instance Pretty ActualParameterPart where pp = undefined

instance Pretty ActualPart where
  pp :: ActualPart -> Doc
pp (APDesignator ActualDesignator
a) = ActualDesignator -> Doc
forall a. Pretty a => a -> Doc
pp ActualDesignator
a
  pp (APFunction Name
f ActualDesignator
a) = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
f Doc -> Doc -> Doc
<+> Doc -> Doc
parens (ActualDesignator -> Doc
forall a. Pretty a => a -> Doc
pp ActualDesignator
a)
  pp (APType TypeMark
t ActualDesignator
a)     = TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t Doc -> Doc -> Doc
<+> Doc -> Doc
parens (ActualDesignator -> Doc
forall a. Pretty a => a -> Doc
pp ActualDesignator
a)

instance Pretty AddingOperator where
  pp :: AddingOperator -> Doc
pp (AddingOperator
Plus)   = Char -> Doc
char Char
'+'
  pp (AddingOperator
Minus)  = Char -> Doc
char Char
'-'
  pp (AddingOperator
Concat) = Char -> Doc
char Char
'&'

instance Pretty Aggregate where
  pp :: Aggregate -> Doc
pp (Aggregate [ElementAssociation]
es) = Doc -> Doc
parens ([Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ElementAssociation -> Doc) -> [ElementAssociation] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ElementAssociation -> Doc
forall a. Pretty a => a -> Doc
pp [ElementAssociation]
es)

instance Pretty AliasDeclaration where
  pp :: AliasDeclaration -> Doc
pp (AliasDeclaration AliasDesignator
a Maybe SubtypeIndication
sub Name
n Maybe Signature
sig) =
        String -> Doc
text String
"ALIAS" Doc -> Doc -> Doc
<+> AliasDesignator -> Doc
forall a. Pretty a => a -> Doc
pp AliasDesignator
a
    Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe SubtypeIndication -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond (Doc
colon Doc -> Doc -> Doc
<+>) Maybe SubtypeIndication
sub
    Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
    Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Signature -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Signature
sig Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty AliasDesignator where
  pp :: AliasDesignator -> Doc
pp (ADIdentifier Identifier
i) = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i
  pp (ADCharacter CharacterLiteral
c)  = CharacterLiteral -> Doc
forall a. Pretty a => a -> Doc
pp CharacterLiteral
c
  pp (ADOperator OperatorSymbol
o)   = OperatorSymbol -> Doc
forall a. Pretty a => a -> Doc
pp OperatorSymbol
o

instance Pretty Allocator where
  pp :: Allocator -> Doc
pp (AllocSub SubtypeIndication
s)  = String -> Doc
text String
"NEW" Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s
  pp (AllocQual QualifiedExpression
q) = String -> Doc
text String
"NEW" Doc -> Doc -> Doc
<+> QualifiedExpression -> Doc
forall a. Pretty a => a -> Doc
pp QualifiedExpression
q

instance Pretty ArchitectureBody where
  pp :: ArchitectureBody -> Doc
pp (ArchitectureBody Identifier
i Name
n ArchitectureDeclarativePart
d ArchitectureStatementPart
s) =
      [Doc] -> Doc
vcat [ Doc
header
           , Doc -> Doc
indent (ArchitectureDeclarativePart -> Doc
forall a. Pretty a => [a] -> Doc
vpp ArchitectureDeclarativePart
d)
           , String -> Doc
text String
"BEGIN"
           , Doc -> Doc
indent (ArchitectureStatementPart -> Doc
forall a. Pretty a => [a] -> Doc
vpp ArchitectureStatementPart
s)
           , Doc
footer
           ]
    where
      header :: Doc
header = String -> Doc
text String
"ARCHITECTURE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i
           Doc -> Doc -> Doc
<+> String -> Doc
text String
"OF" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
           Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS"
      footer :: Doc
footer = String -> Doc
text String
"END ARCHITECTURE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> Doc
semi

--instance Pretty ArchitectureDeclarativePart where pp = undefined

--instance Pretty ArchitectureStatementPart where pp = undefined

instance Pretty ArrayTypeDefinition where
  pp :: ArrayTypeDefinition -> Doc
pp (ArrU UnconstrainedArrayDefinition
u) = UnconstrainedArrayDefinition -> Doc
forall a. Pretty a => a -> Doc
pp UnconstrainedArrayDefinition
u
  pp (ArrC ConstrainedArrayDefinition
c) = ConstrainedArrayDefinition -> Doc
forall a. Pretty a => a -> Doc
pp ConstrainedArrayDefinition
c

instance Pretty Assertion where
  pp :: Assertion -> Doc
pp (Assertion Expression
c Maybe Expression
r Maybe Expression
s) = [Doc] -> Doc
vcat [String -> Doc
text String
"ASSERT" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
c, Doc
report, Doc
severity]
    where
      report :: Doc
report   = Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> Maybe Expression -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond (String -> Doc
text String
"REPORT" Doc -> Doc -> Doc
<+>) Maybe Expression
r
      severity :: Doc
severity = Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> Maybe Expression -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond (String -> Doc
text String
"SEVERITY" Doc -> Doc -> Doc
<+>) Maybe Expression
s

instance Pretty AssertionStatement where
  pp :: AssertionStatement -> Doc
pp (AssertionStatement Maybe Identifier
l Assertion
a) = Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> Assertion -> Doc
forall a. Pretty a => a -> Doc
pp Assertion
a Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty AssociationElement where
  pp :: AssociationElement -> Doc
pp (AssociationElement Maybe FormalPart
f ActualPart
a) = Doc -> Maybe FormalPart -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condR (String -> Doc
text String
"=>") Maybe FormalPart
f Doc -> Doc -> Doc
<+> ActualPart -> Doc
forall a. Pretty a => a -> Doc
pp ActualPart
a

instance Pretty AssociationList where
  pp :: AssociationList -> Doc
pp (AssociationList [AssociationElement]
as) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (AssociationElement -> Doc) -> [AssociationElement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map AssociationElement -> Doc
forall a. Pretty a => a -> Doc
pp [AssociationElement]
as

instance Pretty AttributeDeclaration where
  pp :: AttributeDeclaration -> Doc
pp (AttributeDeclaration Identifier
i TypeMark
t) = String -> Doc
text String
"ATTRIBUTE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t Doc -> Doc -> Doc
<+> Doc
semi

--instance Pretty AttributeDesignator where pp = undefined

instance Pretty AttributeName where
  pp :: AttributeName -> Doc
pp (AttributeName Prefix
p Maybe Signature
s Identifier
d Maybe Expression
e) = Prefix -> Doc
forall a. Pretty a => a -> Doc
pp Prefix
p Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Signature -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Signature
s Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
d Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Expression -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
parens Maybe Expression
e

instance Pretty AttributeSpecification where
  pp :: AttributeSpecification -> Doc
pp (AttributeSpecification Identifier
d EntitySpecification
s Expression
e) =
        String -> Doc
text String
"ATTRIBUTE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
d
    Doc -> Doc -> Doc
<+> String -> Doc
text String
"OF" Doc -> Doc -> Doc
<+> EntitySpecification -> Doc
forall a. Pretty a => a -> Doc
pp EntitySpecification
s
    Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty BaseSpecifier where
  pp :: BaseSpecifier -> Doc
pp BaseSpecifier
BSOctal = Char -> Doc
char Char
'o'
  pp BaseSpecifier
BSBinary = Char -> Doc
char Char
'b'
  pp BaseSpecifier
BSHexadecimal = Char -> Doc
char Char
'x'

instance Pretty BaseUnitDeclaration where pp :: BaseUnitDeclaration -> Doc
pp = String -> BaseUnitDeclaration -> Doc
forall a. HasCallStack => String -> a
error String
"missing: BaseUnitDeclaration" -- todo

instance Pretty BasedLiteral where
  pp :: BasedLiteral -> Doc
pp (BasedLiteral Base
b Base
i Maybe Base
f Maybe Exponent
e) = Base -> Doc
forall a. Pretty a => a -> Doc
pp Base
b Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'#' Doc -> Doc -> Doc
<+> Base -> Doc
forall a. Pretty a => a -> Doc
pp Base
i Doc -> Doc -> Doc
<+> Doc -> Maybe Base -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (Char -> Doc
char Char
'.') Maybe Base
f Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'#' Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Exponent -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Exponent
e

instance Pretty BasicCharacter where pp :: BasicCharacter -> Doc
pp = String -> BasicCharacter -> Doc
forall a. HasCallStack => String -> a
error String
"missing: BasicCharacter" -- todo

instance Pretty BasicGraphicCharacter where pp :: BasicGraphicCharacter -> Doc
pp = String -> BasicGraphicCharacter -> Doc
forall a. HasCallStack => String -> a
error String
"missing: BasicGraphicCharacter" -- todo

instance Pretty BasicIdentifier where pp :: BasicIdentifier -> Doc
pp = String -> BasicIdentifier -> Doc
forall a. HasCallStack => String -> a
error String
"missing: BasicIdentifier" -- todo

instance Pretty BindingIndication where
  pp :: BindingIndication -> Doc
pp (BindingIndication Maybe EntityAspect
e Maybe GenericMapAspect
g Maybe PortMapAspect
p) =
    [Doc] -> Doc
vcat [Doc -> Maybe EntityAspect -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condR (String -> Doc
text String
"USE") Maybe EntityAspect
e, (Doc -> Doc) -> Maybe GenericMapAspect -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe GenericMapAspect
g, (Doc -> Doc) -> Maybe PortMapAspect -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe PortMapAspect
p]

instance Pretty BitStringLiteral where
  pp :: BitStringLiteral -> Doc
pp (BitStringLiteral BaseSpecifier
bs BitValue
bv) = BaseSpecifier -> Doc
forall a. Pretty a => a -> Doc
pp BaseSpecifier
bs Doc -> Doc -> Doc
<> Doc -> Doc
doubleQuotes (BitValue -> Doc
forall a. Pretty a => a -> Doc
pp BitValue
bv)

instance Pretty BitValue where
  pp :: BitValue -> Doc
pp (BitValue String
eds) = String -> Doc
text String
eds

instance Pretty BlockConfiguration where
  pp :: BlockConfiguration -> Doc
pp (BlockConfiguration BlockSpecification
s [UseClause]
u [ConfigurationItem]
c) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"FOR" Doc -> Doc -> Doc
<+> BlockSpecification -> Doc
forall a. Pretty a => a -> Doc
pp BlockSpecification
s
         , Doc -> Doc
indent ([UseClause] -> Doc
forall a. Pretty a => a -> Doc
pp [UseClause]
u)
         , Doc -> Doc
indent ([ConfigurationItem] -> Doc
forall a. Pretty a => a -> Doc
pp [ConfigurationItem]
c)
         , String -> Doc
text String
"END FOR" Doc -> Doc -> Doc
<+> Doc
semi]

instance Pretty BlockDeclarativeItem where
  pp :: BlockDeclarativeItem -> Doc
pp (BDISubprogDecl SubprogramDeclaration
d) = SubprogramDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramDeclaration
d
  pp (BDISubprogBody SubprogramBody
b) = SubprogramBody -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramBody
b
  pp (BDIType TypeDeclaration
t)        = TypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp TypeDeclaration
t
  pp (BDISubtype SubtypeDeclaration
s)     = SubtypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeDeclaration
s
  pp (BDIConstant ConstantDeclaration
c)    = ConstantDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ConstantDeclaration
c
  pp (BDISignal SignalDeclaration
s)      = SignalDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SignalDeclaration
s
  pp (BDIShared VariableDeclaration
v)      = VariableDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp VariableDeclaration
v
  pp (BDIFile FileDeclaration
f)        = FileDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp FileDeclaration
f
  pp (BDIAlias AliasDeclaration
a)       = AliasDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AliasDeclaration
a
  pp (BDIComp ComponentDeclaration
c)        = ComponentDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ComponentDeclaration
c
  pp (BDIAttrDecl AttributeDeclaration
a)    = AttributeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AttributeDeclaration
a
  pp (BDIAttrSpec AttributeSpecification
a)    = AttributeSpecification -> Doc
forall a. Pretty a => a -> Doc
pp AttributeSpecification
a
  pp (BDIConfigSpec ConfigurationSpecification
c)  = ConfigurationSpecification -> Doc
forall a. Pretty a => a -> Doc
pp ConfigurationSpecification
c
  pp (BDIDisconSpec DisconnectionSpecification
d)  = DisconnectionSpecification -> Doc
forall a. Pretty a => a -> Doc
pp DisconnectionSpecification
d
  pp (BDIUseClause UseClause
u)   = UseClause -> Doc
forall a. Pretty a => a -> Doc
pp UseClause
u
  pp (BDIGroupTemp GroupTemplateDeclaration
g)   = GroupTemplateDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupTemplateDeclaration
g
  pp (BDIGroup GroupDeclaration
g)       = GroupDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupDeclaration
g

--instance Pretty BlockDeclarativePart where pp = undefined

instance Pretty BlockHeader where
  pp :: BlockHeader -> Doc
pp (BlockHeader Maybe (GenericClause, Maybe GenericMapAspect)
p Maybe (PortClause, Maybe PortMapAspect)
g) =
      [Doc] -> Doc
vcat [Maybe (GenericClause, Maybe GenericMapAspect) -> Doc
forall a b. (Pretty a, Pretty b) => Maybe (a, Maybe b) -> Doc
go Maybe (GenericClause, Maybe GenericMapAspect)
p, Maybe (PortClause, Maybe PortMapAspect) -> Doc
forall a b. (Pretty a, Pretty b) => Maybe (a, Maybe b) -> Doc
go Maybe (PortClause, Maybe PortMapAspect)
g]
    where
      go :: (Pretty a, Pretty b) => Maybe (a, Maybe b) -> Doc
      go :: Maybe (a, Maybe b) -> Doc
go (Maybe (a, Maybe b)
Nothing)      = Doc
empty
      go (Just (a
a, Maybe b
mb)) = a -> Doc
forall a. Pretty a => a -> Doc
pp a
a Doc -> Doc -> Doc
$+$ (Doc -> Doc) -> Maybe b -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
indent Maybe b
mb

instance Pretty BlockSpecification where
  pp :: BlockSpecification -> Doc
pp (BSArch Name
n)  = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (BSBlock Identifier
l) = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
l
  pp (BSGen Identifier
l)   = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
l

instance Pretty BlockStatement where
  pp :: BlockStatement -> Doc
pp (BlockStatement Identifier
l Maybe Expression
g BlockHeader
h ArchitectureDeclarativePart
d ArchitectureStatementPart
s) =
      Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
l Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
`hangs` [Doc] -> Doc
vcat [Doc
header, Doc
body, Doc
footer]
    where
      header :: Doc
header = String -> Doc
text String
"BLOCK" Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Expression -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
parens Maybe Expression
g Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS" Doc -> Doc -> Doc
`hangs` (BlockHeader -> Doc
forall a. Pretty a => a -> Doc
pp BlockHeader
h Doc -> Doc -> Doc
$$ ArchitectureDeclarativePart -> Doc
forall a. Pretty a => a -> Doc
pp ArchitectureDeclarativePart
d)
      body :: Doc
body   = String -> Doc
text String
"BEGIN" Doc -> Doc -> Doc
`hangs` (ArchitectureStatementPart -> Doc
forall a. Pretty a => a -> Doc
pp ArchitectureStatementPart
s)
      footer :: Doc
footer = String -> Doc
text String
"END BLOCK" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
l

--instance Pretty BlockStatementPart where pp = undefined

instance Pretty CaseStatement where
  pp :: CaseStatement -> Doc
pp (CaseStatement Maybe Identifier
l Expression
e [CaseStatementAlternative]
cs) =
      Maybe Identifier -> Doc -> Doc
forall a. Pretty a => Maybe a -> Doc -> Doc
labels Maybe Identifier
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc
header, Doc
body, Doc
footer]
    where
      header :: Doc
header = String -> Doc
text String
"CASE" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS"
      body :: Doc
body   = Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (CaseStatementAlternative -> Doc)
-> [CaseStatementAlternative] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CaseStatementAlternative -> Doc
forall a. Pretty a => a -> Doc
pp [CaseStatementAlternative]
cs
      footer :: Doc
footer = String -> Doc
text String
"END CASE" Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Identifier
l Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty CaseStatementAlternative where
  pp :: CaseStatementAlternative -> Doc
pp (CaseStatementAlternative Choices
c SequenceOfStatements
ss) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"WHEN" Doc -> Doc -> Doc
<+> Choices -> Doc
forall a. Pretty a => a -> Doc
pp Choices
c Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>"
         , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (SequentialStatement -> Doc) -> SequenceOfStatements -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SequentialStatement -> Doc
forall a. Pretty a => a -> Doc
pp SequenceOfStatements
ss]

instance Pretty CharacterLiteral where
  pp :: CharacterLiteral -> Doc
pp (CLit Char
c) = Doc -> Doc
quotes (Char -> Doc
char Char
c)

instance Pretty Choice where
  pp :: Choice -> Doc
pp (ChoiceSimple SimpleExpression
s) = SimpleExpression -> Doc
forall a. Pretty a => a -> Doc
pp SimpleExpression
s
  pp (ChoiceRange DiscreteRange
r)  = DiscreteRange -> Doc
forall a. Pretty a => a -> Doc
pp DiscreteRange
r
  pp (ChoiceName Identifier
n)   = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
n
  pp (Choice
ChoiceOthers)   = String -> Doc
text String
"OTHERS"

instance Pretty Choices where
  pp :: Choices -> Doc
pp (Choices [Choice]
cs) = [Doc] -> Doc
pipeSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Choice -> Doc) -> [Choice] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Choice -> Doc
forall a. Pretty a => a -> Doc
pp [Choice]
cs

instance Pretty ComponentConfiguration where
  pp :: ComponentConfiguration -> Doc
pp (ComponentConfiguration ComponentSpecification
s Maybe BindingIndication
i Maybe BlockConfiguration
c) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"FOR" Doc -> Doc -> Doc
<+> ComponentSpecification -> Doc
forall a. Pretty a => a -> Doc
pp ComponentSpecification
s
         , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
           [ Doc -> Maybe BindingIndication -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condR Doc
semi Maybe BindingIndication
i
           , (Doc -> Doc) -> Maybe BlockConfiguration -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond  Doc -> Doc
forall a. a -> a
id Maybe BlockConfiguration
c
           ]
         , String -> Doc
text String
"END FOR" Doc -> Doc -> Doc
<+> Doc
semi
         ]

instance Pretty ComponentDeclaration where
  pp :: ComponentDeclaration -> Doc
pp (ComponentDeclaration Identifier
i Maybe GenericClause
g Maybe PortClause
p Maybe Identifier
s) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"COMPONENT" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS"
         , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
           [ (Doc -> Doc) -> Maybe GenericClause -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe GenericClause
g
           , (Doc -> Doc) -> Maybe PortClause -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe PortClause
p
           ]
         , String -> Doc
text String
"END COMPONENT" Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Identifier
s Doc -> Doc -> Doc
<+> Doc
semi
         ]

instance Pretty ComponentInstantiationStatement where
  pp :: ComponentInstantiationStatement -> Doc
pp (ComponentInstantiationStatement Identifier
l InstantiatedUnit
u Maybe GenericMapAspect
g Maybe PortMapAspect
p) =
    Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
l Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
`hangs` (InstantiatedUnit -> Doc
forall a. Pretty a => a -> Doc
pp InstantiatedUnit
u Doc -> Doc -> Doc
`hangs` [Doc] -> Doc
vcat [(Doc -> Doc) -> Maybe GenericMapAspect -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe GenericMapAspect
g, (Doc -> Doc) -> Maybe PortMapAspect -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe PortMapAspect
p])

instance Pretty ComponentSpecification where
  pp :: ComponentSpecification -> Doc
pp (ComponentSpecification InstantiationList
ls Name
n) = InstantiationList -> Doc
forall a. Pretty a => a -> Doc
pp InstantiationList
ls Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n

instance Pretty CompositeTypeDefinition where
  pp :: CompositeTypeDefinition -> Doc
pp (CTDArray ArrayTypeDefinition
at)  = ArrayTypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp ArrayTypeDefinition
at
  pp (CTDRecord RecordTypeDefinition
rt) = RecordTypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp RecordTypeDefinition
rt

instance Pretty ConcurrentAssertionStatement where
  pp :: ConcurrentAssertionStatement -> Doc
pp (ConcurrentAssertionStatement Maybe Identifier
l Bool
p Assertion
a) = Maybe Identifier -> Bool -> Assertion -> Doc
forall a. Pretty a => Maybe Identifier -> Bool -> a -> Doc
postponed Maybe Identifier
l Bool
p Assertion
a

instance Pretty ConcurrentProcedureCallStatement where
  pp :: ConcurrentProcedureCallStatement -> Doc
pp (ConcurrentProcedureCallStatement Maybe Identifier
l Bool
p ProcedureCall
a) = Maybe Identifier -> Bool -> ProcedureCall -> Doc
forall a. Pretty a => Maybe Identifier -> Bool -> a -> Doc
postponed Maybe Identifier
l Bool
p ProcedureCall
a

instance Pretty ConcurrentSignalAssignmentStatement where
  pp :: ConcurrentSignalAssignmentStatement -> Doc
pp (CSASCond Maybe Identifier
l Bool
p ConditionalSignalAssignment
a)   = Maybe Identifier -> Bool -> ConditionalSignalAssignment -> Doc
forall a. Pretty a => Maybe Identifier -> Bool -> a -> Doc
postponed Maybe Identifier
l Bool
p ConditionalSignalAssignment
a
  pp (CSASSelect Maybe Identifier
l Bool
p SelectedSignalAssignment
a) = Maybe Identifier -> Bool -> SelectedSignalAssignment -> Doc
forall a. Pretty a => Maybe Identifier -> Bool -> a -> Doc
postponed Maybe Identifier
l Bool
p SelectedSignalAssignment
a

instance Pretty ConcurrentStatement where
  pp :: ConcurrentStatement -> Doc
pp (ConBlock BlockStatement
b)     = BlockStatement -> Doc
forall a. Pretty a => a -> Doc
pp BlockStatement
b
  pp (ConProcess ProcessStatement
p)   = ProcessStatement -> Doc
forall a. Pretty a => a -> Doc
pp ProcessStatement
p
  pp (ConProcCall ConcurrentProcedureCallStatement
c)  = ConcurrentProcedureCallStatement -> Doc
forall a. Pretty a => a -> Doc
pp ConcurrentProcedureCallStatement
c
  pp (ConAssertion ConcurrentAssertionStatement
a) = ConcurrentAssertionStatement -> Doc
forall a. Pretty a => a -> Doc
pp ConcurrentAssertionStatement
a
  pp (ConSignalAss ConcurrentSignalAssignmentStatement
s) = ConcurrentSignalAssignmentStatement -> Doc
forall a. Pretty a => a -> Doc
pp ConcurrentSignalAssignmentStatement
s
  pp (ConComponent ComponentInstantiationStatement
c) = ComponentInstantiationStatement -> Doc
forall a. Pretty a => a -> Doc
pp ComponentInstantiationStatement
c
  pp (ConGenerate GenerateStatement
g)  = GenerateStatement -> Doc
forall a. Pretty a => a -> Doc
pp GenerateStatement
g

--instance Pretty Condition where pp = undefined

instance Pretty ConditionClause where
  pp :: ConditionClause -> Doc
pp (ConditionClause Expression
e) = String -> Doc
text String
"UNTIL" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e

instance Pretty ConditionalSignalAssignment where
  pp :: ConditionalSignalAssignment -> Doc
pp (ConditionalSignalAssignment Target
t Options
o ConditionalWaveforms
w) = Target -> Doc
forall a. Pretty a => a -> Doc
pp Target
t Doc -> Doc -> Doc
<+> String -> Doc
text String
"<=" Doc -> Doc -> Doc
<+> Options -> Doc
forall a. Pretty a => a -> Doc
pp Options
o Doc -> Doc -> Doc
<+> ConditionalWaveforms -> Doc
forall a. Pretty a => a -> Doc
pp ConditionalWaveforms
w Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty ConditionalWaveforms where
  pp :: ConditionalWaveforms -> Doc
pp (ConditionalWaveforms [(Waveform, Expression)]
ws (Waveform
w, Maybe Expression
c)) =
      [Doc] -> Doc
vcat [Doc]
ws' Doc -> Doc -> Doc
$$ Waveform -> Doc
forall a. Pretty a => a -> Doc
pp Waveform
w Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"WHEN") Maybe Expression
c
    where
      ws' :: [Doc]
ws' = ((Waveform, Expression) -> Doc)
-> [(Waveform, Expression)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Waveform
w, Expression
c) -> Waveform -> Doc
forall a. Pretty a => a -> Doc
pp Waveform
w Doc -> Doc -> Doc
<+> String -> Doc
text String
"WHEN" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
c Doc -> Doc -> Doc
<+> String -> Doc
text String
"ELSE") [(Waveform, Expression)]
ws
  
instance Pretty ConfigurationDeclaration where
  pp :: ConfigurationDeclaration -> Doc
pp (ConfigurationDeclaration Identifier
i Name
n ConfigurationDeclarativePart
d BlockConfiguration
b) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"CONFIGURATION" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"OF" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS"
         , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
           [ ConfigurationDeclarativePart -> Doc
forall a. Pretty a => a -> Doc
pp ConfigurationDeclarativePart
d
           , BlockConfiguration -> Doc
forall a. Pretty a => a -> Doc
pp BlockConfiguration
b
           ]
         , String -> Doc
text String
"END CONFIGURATION" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i
         ]

instance Pretty ConfigurationDeclarativeItem where
  pp :: ConfigurationDeclarativeItem -> Doc
pp (CDIUse UseClause
u)      = UseClause -> Doc
forall a. Pretty a => a -> Doc
pp UseClause
u
  pp (CDIAttrSpec AttributeSpecification
a) = AttributeSpecification -> Doc
forall a. Pretty a => a -> Doc
pp AttributeSpecification
a
  pp (CDIGroup GroupDeclaration
g)    = GroupDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupDeclaration
g

--instance Pretty ConfigurationDeclarativePart where pp = undefined

instance Pretty ConfigurationItem where
  pp :: ConfigurationItem -> Doc
pp (CIBlock BlockConfiguration
b) = BlockConfiguration -> Doc
forall a. Pretty a => a -> Doc
pp BlockConfiguration
b
  pp (CIComp ComponentConfiguration
c)  = ComponentConfiguration -> Doc
forall a. Pretty a => a -> Doc
pp ComponentConfiguration
c

instance Pretty ConfigurationSpecification where
  pp :: ConfigurationSpecification -> Doc
pp (ConfigurationSpecification ComponentSpecification
s BindingIndication
i) = String -> Doc
text String
"FOR" Doc -> Doc -> Doc
<+> ComponentSpecification -> Doc
forall a. Pretty a => a -> Doc
pp ComponentSpecification
s Doc -> Doc -> Doc
<+> BindingIndication -> Doc
forall a. Pretty a => a -> Doc
pp BindingIndication
i Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty ConstantDeclaration where
  pp :: ConstantDeclaration -> Doc
pp (ConstantDeclaration IdentifierList
is SubtypeIndication
s Maybe Expression
e) =
    String -> Doc
text String
"CONSTANT" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep ((Identifier -> Doc) -> IdentifierList -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
is) Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
":=") Maybe Expression
e Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty ConstrainedArrayDefinition where
  pp :: ConstrainedArrayDefinition -> Doc
pp (ConstrainedArrayDefinition IndexConstraint
i SubtypeIndication
s) = String -> Doc
text String
"ARRAY" Doc -> Doc -> Doc
<+> IndexConstraint -> Doc
forall a. Pretty a => a -> Doc
pp IndexConstraint
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"OF" Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s

instance Pretty Constraint where
  pp :: Constraint -> Doc
pp (CRange RangeConstraint
r) = RangeConstraint -> Doc
forall a. Pretty a => a -> Doc
pp RangeConstraint
r
  pp (CIndex IndexConstraint
i) = IndexConstraint -> Doc
forall a. Pretty a => a -> Doc
pp IndexConstraint
i

instance Pretty ContextClause where
  pp :: ContextClause -> Doc
pp (ContextClause [ContextItem]
items) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ContextItem -> Doc) -> [ContextItem] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ContextItem -> Doc
forall a. Pretty a => a -> Doc
pp [ContextItem]
items

instance Pretty ContextItem where
  pp :: ContextItem -> Doc
pp (ContextLibrary LibraryClause
l) = LibraryClause -> Doc
forall a. Pretty a => a -> Doc
pp LibraryClause
l
  pp (ContextUse UseClause
u)     = UseClause -> Doc
forall a. Pretty a => a -> Doc
pp UseClause
u

instance Pretty DecimalLiteral where
  pp :: DecimalLiteral -> Doc
pp (DecimalLiteral Base
i Maybe Base
f Maybe Exponent
e) = Base -> Doc
forall a. Pretty a => a -> Doc
pp Base
i Doc -> Doc -> Doc
<+> Doc -> Maybe Base -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (Char -> Doc
char Char
'.') Maybe Base
f Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Exponent -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Exponent
e

instance Pretty Declaration where
  pp :: Declaration -> Doc
pp (DType TypeDeclaration
t)          = TypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp TypeDeclaration
t
  pp (DSubtype SubtypeDeclaration
s)       = SubtypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeDeclaration
s
  pp (DObject ObjectDeclaration
o)        = ObjectDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ObjectDeclaration
o
  pp (DAlias AliasDeclaration
a)         = AliasDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AliasDeclaration
a
  pp (DComponent ComponentDeclaration
c)     = ComponentDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ComponentDeclaration
c
  pp (DAttribute AttributeDeclaration
a)     = AttributeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AttributeDeclaration
a
  pp (DGroupTemplate GroupTemplateDeclaration
g) = GroupTemplateDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupTemplateDeclaration
g
  pp (DGroup GroupDeclaration
g)         = GroupDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupDeclaration
g
  pp (DEntity EntityDeclaration
e)        = EntityDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp EntityDeclaration
e
  pp (DConfiguration ConfigurationDeclaration
c) = ConfigurationDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ConfigurationDeclaration
c
  pp (DSubprogram SubprogramDeclaration
s)    = SubprogramDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramDeclaration
s
  pp (DPackage PackageDeclaration
p)       = PackageDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp PackageDeclaration
p

instance Pretty DelayMechanism where
  pp :: DelayMechanism -> Doc
pp (DelayMechanism
DMechTransport)  = String -> Doc
text String
"TRANSPORT"
  pp (DMechInertial Maybe Expression
e) = Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"REJECT") Maybe Expression
e Doc -> Doc -> Doc
<+> String -> Doc
text String
"INERTIAL"

instance Pretty DesignFile where
  pp :: DesignFile -> Doc
pp (DesignFile [DesignUnit]
units) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (DesignUnit -> Doc) -> [DesignUnit] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DesignUnit -> Doc
forall a. Pretty a => a -> Doc
pp [DesignUnit]
units

instance Pretty DesignUnit where
  pp :: DesignUnit -> Doc
pp (DesignUnit ContextClause
ctxt LibraryUnit
lib) = [Doc] -> Doc
vcat [ContextClause -> Doc
forall a. Pretty a => a -> Doc
pp ContextClause
ctxt, LibraryUnit -> Doc
forall a. Pretty a => a -> Doc
pp LibraryUnit
lib]

instance Pretty Designator where
  pp :: Designator -> Doc
pp (DId Identifier
i) = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i
  pp (DOp OperatorSymbol
o) = OperatorSymbol -> Doc
forall a. Pretty a => a -> Doc
pp OperatorSymbol
o

instance Pretty Direction where
  pp :: Direction -> Doc
pp (Direction
To)     = String -> Doc
text String
"TO"
  pp (Direction
DownTo) = String -> Doc
text String
"DOWNTO"

instance Pretty DisconnectionSpecification where
  pp :: DisconnectionSpecification -> Doc
pp (DisconnectionSpecification GuardedSignalSpecification
g Expression
e) =
    String -> Doc
text String
"DISCONNECT" Doc -> Doc -> Doc
<+> GuardedSignalSpecification -> Doc
forall a. Pretty a => a -> Doc
pp GuardedSignalSpecification
g Doc -> Doc -> Doc
<+> String -> Doc
text String
"AFTER" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty DiscreteRange where
  pp :: DiscreteRange -> Doc
pp (DRSub SubtypeIndication
s)   = SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s
  pp (DRRange Range
r) = Range -> Doc
forall a. Pretty a => a -> Doc
pp Range
r

instance Pretty ElementAssociation where
  pp :: ElementAssociation -> Doc
pp (ElementAssociation Maybe Choices
c Expression
e) = Doc -> Maybe Choices -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condR (String -> Doc
text String
"=>") Maybe Choices
c Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e

instance Pretty ElementDeclaration where
  pp :: ElementDeclaration -> Doc
pp (ElementDeclaration IdentifierList
is SubtypeIndication
s) = IdentifierList -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
is Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s Doc -> Doc -> Doc
<+> Doc
semi

--instance Pretty ElementSubtypeDefinition where pp = undefined

instance Pretty EntityAspect where
  pp :: EntityAspect -> Doc
pp (EAEntity Name
n Maybe Identifier
i) = String -> Doc
text String
"ENTITY" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
parens Maybe Identifier
i
  pp (EAConfig Name
n)   = String -> Doc
text String
"CONFIGURATION" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (EntityAspect
EAOpen)       = String -> Doc
text String
"OPEN"

instance Pretty EntityClass where
  pp :: EntityClass -> Doc
pp EntityClass
ENTITY        = String -> Doc
text String
"ENTITY"
  pp EntityClass
ARCHITECTURE  = String -> Doc
text String
"ARCHITECTURE"
  pp EntityClass
CONFIGURATION = String -> Doc
text String
"CONFIGURATION"
  pp EntityClass
PROCEDURE     = String -> Doc
text String
"PROCEDURE"
  pp EntityClass
FUNCTION      = String -> Doc
text String
"FUNCTION"
  pp EntityClass
PACKAGE       = String -> Doc
text String
"PACKAGE"
  pp EntityClass
TYPE          = String -> Doc
text String
"TYPE"
  pp EntityClass
SUBTYPE       = String -> Doc
text String
"SUBTYPE"
  pp EntityClass
CONSTANT      = String -> Doc
text String
"CONSTANT"
  pp EntityClass
SIGNAL        = String -> Doc
text String
"SIGNAL"
  pp EntityClass
VARIABLE      = String -> Doc
text String
"VARIABLE"
  pp EntityClass
COMPONENT     = String -> Doc
text String
"COMPONENT"
  pp EntityClass
LABEL         = String -> Doc
text String
"LABEL"
  pp EntityClass
LITERAL       = String -> Doc
text String
"LITERAL"
  pp EntityClass
UNITS         = String -> Doc
text String
"UNITS"
  pp EntityClass
GROUP         = String -> Doc
text String
"GROUP"
  pp EntityClass
FILE          = String -> Doc
text String
"FILE"

instance Pretty EntityClassEntry where
  pp :: EntityClassEntry -> Doc
pp (EntityClassEntry EntityClass
c Bool
m) = EntityClass -> Doc
forall a. Pretty a => a -> Doc
pp EntityClass
c Doc -> Doc -> Doc
<+> Bool -> Doc -> Doc
when Bool
m (String -> Doc
text String
"<>")

--instance Pretty EntityClassEntryList where pp = undefined

instance Pretty EntityDeclaration where
  pp :: EntityDeclaration -> Doc
pp (EntityDeclaration Identifier
i EntityHeader
h EntityDeclarativePart
d Maybe EntityStatementPart
s) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"ENTITY" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS"
         , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
           [ EntityHeader -> Doc
forall a. Pretty a => a -> Doc
pp EntityHeader
h
           , EntityDeclarativePart -> Doc
forall a. Pretty a => a -> Doc
pp EntityDeclarativePart
d
           ]
         , ((Doc -> Doc) -> Maybe EntityStatementPart -> Doc)
-> Maybe EntityStatementPart -> (Doc -> Doc) -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Doc -> Doc) -> Maybe EntityStatementPart -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Maybe EntityStatementPart
s ((Doc -> Doc) -> Doc) -> (Doc -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Doc
ss ->
             String -> Doc
text String
"BEGIN" Doc -> Doc -> Doc
`hangs` Doc
ss             
         , String -> Doc
text String
"END ENTITY" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> Doc
semi
         ]

instance Pretty EntityDeclarativeItem where
  pp :: EntityDeclarativeItem -> Doc
pp (EDISubprogDecl SubprogramDeclaration
s)  = SubprogramDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramDeclaration
s
  pp (EDISubprogBody SubprogramBody
b)  = SubprogramBody -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramBody
b
  pp (EDIType TypeDeclaration
t)         = TypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp TypeDeclaration
t
  pp (EDISubtype SubtypeDeclaration
s)      = SubtypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeDeclaration
s
  pp (EDIConstant ConstantDeclaration
c)     = ConstantDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ConstantDeclaration
c
  pp (EDISignal SignalDeclaration
s)       = SignalDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SignalDeclaration
s
  pp (EDIShared VariableDeclaration
s)       = VariableDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp VariableDeclaration
s
  pp (EDIFile FileDeclaration
f)         = FileDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp FileDeclaration
f
  pp (EDIAlias AliasDeclaration
a)        = AliasDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AliasDeclaration
a
  pp (EDIAttrDecl AttributeDeclaration
a)     = AttributeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AttributeDeclaration
a
  pp (EDIAttrSpec AttributeSpecification
a)     = AttributeSpecification -> Doc
forall a. Pretty a => a -> Doc
pp AttributeSpecification
a
  pp (EDIDiscSpec DisconnectionSpecification
d)     = DisconnectionSpecification -> Doc
forall a. Pretty a => a -> Doc
pp DisconnectionSpecification
d
  pp (EDIUseClause UseClause
u)    = UseClause -> Doc
forall a. Pretty a => a -> Doc
pp UseClause
u
  pp (EDIGroupTemp GroupTemplateDeclaration
g)    = GroupTemplateDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupTemplateDeclaration
g
  pp (EDIGroup GroupDeclaration
g)        = GroupDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupDeclaration
g

--instance Pretty EntityDeclarativePart where pp = undefined

instance Pretty EntityDesignator where
  pp :: EntityDesignator -> Doc
pp (EntityDesignator EntityTag
t Maybe Signature
s) = EntityTag -> Doc
forall a. Pretty a => a -> Doc
pp EntityTag
t Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Signature -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Signature
s

instance Pretty EntityHeader where
  pp :: EntityHeader -> Doc
pp (EntityHeader Maybe GenericClause
g Maybe PortClause
p) = [Doc] -> Doc
vcat [(Doc -> Doc) -> Maybe GenericClause -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
indent Maybe GenericClause
g, (Doc -> Doc) -> Maybe PortClause -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
indent Maybe PortClause
p]

instance Pretty EntityNameList where
  pp :: EntityNameList -> Doc
pp (ENLDesignators [EntityDesignator]
es) = [Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (EntityDesignator -> Doc) -> [EntityDesignator] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EntityDesignator -> Doc
forall a. Pretty a => a -> Doc
pp [EntityDesignator]
es

instance Pretty EntitySpecification where
  pp :: EntitySpecification -> Doc
pp (EntitySpecification EntityNameList
ns EntityClass
c) = EntityNameList -> Doc
forall a. Pretty a => a -> Doc
pp EntityNameList
ns Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> EntityClass -> Doc
forall a. Pretty a => a -> Doc
pp EntityClass
c

instance Pretty EntityStatement where
  pp :: EntityStatement -> Doc
pp (ESConcAssert ConcurrentAssertionStatement
a)  = ConcurrentAssertionStatement -> Doc
forall a. Pretty a => a -> Doc
pp ConcurrentAssertionStatement
a
  pp (ESPassiveConc ConcurrentProcedureCallStatement
p) = ConcurrentProcedureCallStatement -> Doc
forall a. Pretty a => a -> Doc
pp ConcurrentProcedureCallStatement
p
  pp (ESPassiveProc ProcessStatement
p) = ProcessStatement -> Doc
forall a. Pretty a => a -> Doc
pp ProcessStatement
p

--instance Pretty EntityStatementPart where pp = undefined

instance Pretty EntityTag where
  pp :: EntityTag -> Doc
pp (ETName Identifier
n) = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
n
  pp (ETChar CharacterLiteral
c) = CharacterLiteral -> Doc
forall a. Pretty a => a -> Doc
pp CharacterLiteral
c
  pp (ETOp OperatorSymbol
o)   = OperatorSymbol -> Doc
forall a. Pretty a => a -> Doc
pp OperatorSymbol
o

instance Pretty EnumerationLiteral where
  pp :: EnumerationLiteral -> Doc
pp (EId Identifier
i)   = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i
  pp (EChar CharacterLiteral
c) = CharacterLiteral -> Doc
forall a. Pretty a => a -> Doc
pp CharacterLiteral
c

instance Pretty EnumerationTypeDefinition where
  pp :: EnumerationTypeDefinition -> Doc
pp (EnumerationTypeDefinition [EnumerationLiteral]
es) = Doc -> Doc
parens (Doc -> Doc)
-> ([EnumerationLiteral] -> Doc) -> [EnumerationLiteral] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
commaSep ([Doc] -> Doc)
-> ([EnumerationLiteral] -> [Doc]) -> [EnumerationLiteral] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumerationLiteral -> Doc) -> [EnumerationLiteral] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EnumerationLiteral -> Doc
forall a. Pretty a => a -> Doc
pp ([EnumerationLiteral] -> Doc) -> [EnumerationLiteral] -> Doc
forall a b. (a -> b) -> a -> b
$ [EnumerationLiteral]
es

instance Pretty ExitStatement where
  pp :: ExitStatement -> Doc
pp (ExitStatement Maybe Identifier
l Maybe Identifier
b Maybe Expression
c) =
    Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> String -> Doc
text String
"EXIT" Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Identifier
b Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"WHEN") Maybe Expression
c Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty Exponent where
  pp :: Exponent -> Doc
pp (ExponentPos Base
i) = Char -> Doc
char Char
'E' Doc -> Doc -> Doc
<+> Base -> Doc
forall a. Pretty a => a -> Doc
pp Base
i
  pp (ExponentNeg Base
i) = Char -> Doc
char Char
'E' Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<+> Base -> Doc
forall a. Pretty a => a -> Doc
pp Base
i

instance Pretty Expression where
  pp :: Expression -> Doc
pp (EAnd [Relation]
rs)    = String -> [Doc] -> Doc
textSep String
"AND"  ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Relation -> Doc) -> [Relation] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Relation -> Doc
forall a. Pretty a => a -> Doc
pp [Relation]
rs
  pp (EOr [Relation]
rs)     = String -> [Doc] -> Doc
textSep String
"OR"   ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Relation -> Doc) -> [Relation] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Relation -> Doc
forall a. Pretty a => a -> Doc
pp [Relation]
rs
  pp (EXor [Relation]
rs)    = String -> [Doc] -> Doc
textSep String
"XOR"  ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Relation -> Doc) -> [Relation] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Relation -> Doc
forall a. Pretty a => a -> Doc
pp [Relation]
rs
  pp (ENand Relation
r Maybe Relation
rs) = Relation -> Doc
forall a. Pretty a => a -> Doc
pp Relation
r Doc -> Doc -> Doc
<+> Doc -> Maybe Relation -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"NAND") Maybe Relation
rs
  pp (ENor Relation
r Maybe Relation
rs)  = Relation -> Doc
forall a. Pretty a => a -> Doc
pp Relation
r Doc -> Doc -> Doc
<+> Doc -> Maybe Relation -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"NOR")  Maybe Relation
rs
  pp (EXnor [Relation]
rs)   = String -> [Doc] -> Doc
textSep String
"XNOR" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Relation -> Doc) -> [Relation] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Relation -> Doc
forall a. Pretty a => a -> Doc
pp [Relation]
rs

instance Pretty ExtendedIdentifier where pp :: ExtendedIdentifier -> Doc
pp = String -> ExtendedIdentifier -> Doc
forall a. HasCallStack => String -> a
error String
"missing: ExtendedIdentifier" -- todo

instance Pretty Factor where
  pp :: Factor -> Doc
pp (FacPrim Primary
p Maybe Primary
mp) = Primary -> Doc
forall a. Pretty a => a -> Doc
pp Primary
p Doc -> Doc -> Doc
<+> Doc -> Maybe Primary -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"**") Maybe Primary
mp
  pp (FacAbs Primary
p)     = String -> Doc
text String
"ABS" Doc -> Doc -> Doc
<+> Primary -> Doc
forall a. Pretty a => a -> Doc
pp Primary
p
  pp (FacNot Primary
p)     = String -> Doc
text String
"NOT" Doc -> Doc -> Doc
<+> Primary -> Doc
forall a. Pretty a => a -> Doc
pp Primary
p

instance Pretty FileDeclaration where
  pp :: FileDeclaration -> Doc
pp (FileDeclaration IdentifierList
is SubtypeIndication
s Maybe FileOpenInformation
o) =
        String -> Doc
text String
"FILE" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep ((Identifier -> Doc) -> IdentifierList -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
is)
    Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe FileOpenInformation -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe FileOpenInformation
o Doc -> Doc -> Doc
<+> Doc
semi

--instance Pretty FileLogicalName where pp = undefined

instance Pretty FileOpenInformation where
  pp :: FileOpenInformation -> Doc
pp (FileOpenInformation Maybe Expression
e Expression
n) = Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"OPEN") Maybe Expression
e Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
n

instance Pretty FileTypeDefinition where
  pp :: FileTypeDefinition -> Doc
pp (FileTypeDefinition TypeMark
t) = String -> Doc
text String
"FILE OF" Doc -> Doc -> Doc
<+> TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t

--instance Pretty FloatingTypeDefinition where pp = undefined

instance Pretty FormalDesignator where
  pp :: FormalDesignator -> Doc
pp (FDGeneric Name
n)   = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (FDPort Name
n)      = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (FDParameter Name
n) = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n

--instance Pretty FormalParameterList where pp = undefined

instance Pretty FormalPart where
  pp :: FormalPart -> Doc
pp (FPDesignator FormalDesignator
d) = FormalDesignator -> Doc
forall a. Pretty a => a -> Doc
pp FormalDesignator
d
  pp (FPFunction Name
n FormalDesignator
d) = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n Doc -> Doc -> Doc
<+> Doc -> Doc
parens (FormalDesignator -> Doc
forall a. Pretty a => a -> Doc
pp FormalDesignator
d)
  pp (FPType TypeMark
t FormalDesignator
d)     = TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t Doc -> Doc -> Doc
<+> Doc -> Doc
parens (FormalDesignator -> Doc
forall a. Pretty a => a -> Doc
pp FormalDesignator
d)

instance Pretty FullTypeDeclaration where
  pp :: FullTypeDeclaration -> Doc
pp (FullTypeDeclaration Identifier
i TypeDefinition
t) = String -> Doc
text String
"TYPE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS" Doc -> Doc -> Doc
<+> TypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp TypeDefinition
t Doc -> Doc -> Doc
<+> Doc
semi

-- todo: printing its arguments like this is a slight hack, as we want different
-- styles for association lists in, for example, entity port declarations and
-- for functions. The fix would be to make 'ActualParamaterPart' a full data
-- type, and not a short-hand for 'AssociationList'.
instance Pretty FunctionCall where
  pp :: FunctionCall -> Doc
pp (FunctionCall Name
n Maybe AssociationList
Nothing) = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n Doc -> Doc -> Doc
<+> String -> Doc
text String
"()"
  pp (FunctionCall Name
n (Just (AssociationList [AssociationElement]
as)))
    = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (AssociationElement -> Doc) -> [AssociationElement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map AssociationElement -> Doc
forall a. Pretty a => a -> Doc
pp [AssociationElement]
as)
{-
  pp (FunctionCall n p) = pp n <+> cond parens p
-}

instance Pretty GenerateStatement where
  pp :: GenerateStatement -> Doc
pp (GenerateStatement Identifier
l GenerationScheme
g Maybe ArchitectureDeclarativePart
d ArchitectureStatementPart
s) =
    Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
l Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
`hangs` [Doc] -> Doc
vcat
      [ GenerationScheme -> Doc
forall a. Pretty a => a -> Doc
pp GenerationScheme
g Doc -> Doc -> Doc
<+> String -> Doc
text String
"GENERATE"
      , Doc
-> (ArchitectureDeclarativePart -> Doc)
-> Maybe ArchitectureDeclarativePart
-> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
indent (Doc -> Doc)
-> (ArchitectureDeclarativePart -> Doc)
-> ArchitectureDeclarativePart
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc)
-> (ArchitectureDeclarativePart -> [Doc])
-> ArchitectureDeclarativePart
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockDeclarativeItem -> Doc)
-> ArchitectureDeclarativePart -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BlockDeclarativeItem -> Doc
forall a. Pretty a => a -> Doc
pp) Maybe ArchitectureDeclarativePart
d
      , (Doc -> Doc) -> Maybe ArchitectureDeclarativePart -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond (Doc -> Doc -> Doc
forall a b. a -> b -> a
const (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"BEGIN") Maybe ArchitectureDeclarativePart
d
      , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ConcurrentStatement -> Doc) -> ArchitectureStatementPart -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConcurrentStatement -> Doc
forall a. Pretty a => a -> Doc
pp ArchitectureStatementPart
s
      , String -> Doc
text String
"END GENERATE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
l Doc -> Doc -> Doc
<+> Doc
semi
      ]

instance Pretty GenerationScheme where
  pp :: GenerationScheme -> Doc
pp (GSFor ParameterSpecification
p) = String -> Doc
text String
"FOR" Doc -> Doc -> Doc
<+> ParameterSpecification -> Doc
forall a. Pretty a => a -> Doc
pp ParameterSpecification
p
  pp (GSIf Expression
c)  = String -> Doc
text String
"IF" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
c

instance Pretty GenericClause where
  pp :: GenericClause -> Doc
pp (GenericClause GenericList
ls) = String -> Doc
text String
"GENERIC" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (GenericList -> Doc
forall a. Pretty a => a -> Doc
pp GenericList
ls) Doc -> Doc -> Doc
<+> Doc
semi

--instance Pretty GenericList where pp = undefined

instance Pretty GenericMapAspect where
  pp :: GenericMapAspect -> Doc
pp (GenericMapAspect AssociationList
as) = String -> Doc
text String
"GENERIC MAP" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (AssociationList -> Doc
forall a. Pretty a => a -> Doc
pp AssociationList
as) Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty GraphicCharacter where pp :: GraphicCharacter -> Doc
pp = String -> GraphicCharacter -> Doc
forall a. HasCallStack => String -> a
error String
"missing: GraphicCharacter" -- todo

instance Pretty GroupConstituent where
  pp :: GroupConstituent -> Doc
pp (GCName Name
n) = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (GCChar CharacterLiteral
c) = CharacterLiteral -> Doc
forall a. Pretty a => a -> Doc
pp CharacterLiteral
c

--instance Pretty GroupConstituentList where pp = undefined

instance Pretty GroupTemplateDeclaration where
  pp :: GroupTemplateDeclaration -> Doc
pp (GroupTemplateDeclaration Identifier
i EntityClassEntryList
cs) = String -> Doc
text String
"GROUP" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (EntityClassEntryList -> Doc
forall a. Pretty a => a -> Doc
pp EntityClassEntryList
cs) Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty GroupDeclaration where
  pp :: GroupDeclaration -> Doc
pp (GroupDeclaration Identifier
i Name
n GroupConstituentList
cs) = String -> Doc
text String
"GROUP" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n Doc -> Doc -> Doc
<+> Doc -> Doc
parens (GroupConstituentList -> Doc
forall a. Pretty a => a -> Doc
pp GroupConstituentList
cs) Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty GuardedSignalSpecification where
  pp :: GuardedSignalSpecification -> Doc
pp (GuardedSignalSpecification SignalList
ss TypeMark
t) = SignalList -> Doc
forall a. Pretty a => a -> Doc
pp SignalList
ss Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t

instance Pretty Identifier where
  pp :: Identifier -> Doc
pp (Ident String
i) = String -> Doc
text String
i

--instance Pretty IdentifierList where pp = undefined

instance Pretty IfStatement where
  pp :: IfStatement -> Doc
pp (IfStatement Maybe Identifier
l (Expression
tc, SequenceOfStatements
ts) [(Expression, SequenceOfStatements)]
a Maybe SequenceOfStatements
e) =
    Maybe Identifier -> Doc -> Doc
forall a. Pretty a => Maybe a -> Doc -> Doc
labels Maybe Identifier
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
      [ (String -> Doc
text String
"IF" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
tc Doc -> Doc -> Doc
<+> String -> Doc
text String
"THEN") Doc -> Doc -> Doc
`hangs` SequenceOfStatements -> Doc
forall a. Pretty a => [a] -> Doc
vpp SequenceOfStatements
ts
      , [(Expression, SequenceOfStatements)] -> Doc
elseIf' [(Expression, SequenceOfStatements)]
a
      , Maybe SequenceOfStatements -> Doc
else'   Maybe SequenceOfStatements
e
      , String -> Doc
text String
"END IF" Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Identifier
l Doc -> Doc -> Doc
<+> Doc
semi
      ]
    where
      elseIf' :: [(Condition, SequenceOfStatements)] -> Doc
      elseIf' :: [(Expression, SequenceOfStatements)] -> Doc
elseIf' = [Doc] -> Doc
vcat ([Doc] -> Doc)
-> ([(Expression, SequenceOfStatements)] -> [Doc])
-> [(Expression, SequenceOfStatements)]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Expression, SequenceOfStatements) -> Doc)
-> [(Expression, SequenceOfStatements)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Expression
c, SequenceOfStatements
ss) -> (String -> Doc
text String
"ELSIF" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
c Doc -> Doc -> Doc
<+> String -> Doc
text String
"THEN") Doc -> Doc -> Doc
`hangs` (SequenceOfStatements -> Doc
forall a. Pretty a => [a] -> Doc
vpp SequenceOfStatements
ss))

      else'   :: Maybe SequenceOfStatements -> Doc
      else' :: Maybe SequenceOfStatements -> Doc
else' (Maybe SequenceOfStatements
Nothing) = Doc
empty
      else' (Just SequenceOfStatements
ss) = String -> Doc
text String
"ELSE" Doc -> Doc -> Doc
`hangs` (SequenceOfStatements -> Doc
forall a. Pretty a => [a] -> Doc
vpp SequenceOfStatements
ss)

instance Pretty IncompleteTypeDeclaration where
  pp :: IncompleteTypeDeclaration -> Doc
pp (IncompleteTypeDeclaration Identifier
i) = String -> Doc
text String
"TYPE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty IndexConstraint where
  pp :: IndexConstraint -> Doc
pp (IndexConstraint [DiscreteRange]
rs) = Doc -> Doc
parens ([Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (DiscreteRange -> Doc) -> [DiscreteRange] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map DiscreteRange -> Doc
forall a. Pretty a => a -> Doc
pp [DiscreteRange]
rs)

instance Pretty IndexSpecification where
  pp :: IndexSpecification -> Doc
pp (ISRange DiscreteRange
r) = DiscreteRange -> Doc
forall a. Pretty a => a -> Doc
pp DiscreteRange
r
  pp (ISExp Expression
e)   = Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e

instance Pretty IndexSubtypeDefinition where
  pp :: IndexSubtypeDefinition -> Doc
pp (IndexSubtypeDefinition TypeMark
t) = TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t Doc -> Doc -> Doc
<+> String -> Doc
text String
"RANGE" Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty IndexedName where
  pp :: IndexedName -> Doc
pp (IndexedName Prefix
p [Expression]
es) = Prefix -> Doc
forall a. Pretty a => a -> Doc
pp Prefix
p Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Expression -> Doc) -> [Expression] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> Doc
forall a. Pretty a => a -> Doc
pp [Expression]
es)

instance Pretty InstantiatedUnit where
  pp :: InstantiatedUnit -> Doc
pp (IUComponent Name
n) = String -> Doc
text String
"COMPONENT" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (IUEntity Name
n Maybe Identifier
i)  = String -> Doc
text String
"ENTITY" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
parens Maybe Identifier
i
  pp (IUConfig Name
n)    = String -> Doc
text String
"CONFIGURATION" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n

instance Pretty InstantiationList where
  pp :: InstantiationList -> Doc
pp (ILLabels IdentifierList
ls) = [Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Identifier -> Doc) -> IdentifierList -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
ls
  pp (InstantiationList
ILOthers)    = String -> Doc
text String
"OTHERS"
  pp (InstantiationList
ILAll)       = String -> Doc
text String
"ALL"

instance Pretty Integer where pp :: Base -> Doc
pp = Base -> Doc
integer

--instance Pretty IntegerTypeDefinition where pp = undefined

instance Pretty InterfaceDeclaration where
  pp :: InterfaceDeclaration -> Doc
pp (InterfaceConstantDeclaration IdentifierList
is SubtypeIndication
s Maybe Expression
e) =
    String -> Doc
text String
"CONSTANT" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep ((Identifier -> Doc) -> IdentifierList -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
is) Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
"IN" Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
":=") Maybe Expression
e
  pp (InterfaceSignalDeclaration IdentifierList
is Maybe Mode
m SubtypeIndication
s Bool
b Maybe Expression
e) =
    [Doc] -> Doc
commaSep ((Identifier -> Doc) -> IdentifierList -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
is) Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Mode -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Mode
m Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s Doc -> Doc -> Doc
<+> Bool -> Doc -> Doc
when Bool
b (String -> Doc
text String
"BUS") Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
":=") Maybe Expression
e
  pp (InterfaceVariableDeclaration IdentifierList
is Maybe Mode
m SubtypeIndication
s Maybe Expression
e) =
    String -> Doc
text String
"VARIABLE" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep ((Identifier -> Doc) -> IdentifierList -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
is) Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Mode -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Mode
m Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
":=") Maybe Expression
e
  pp (InterfaceFileDeclaration IdentifierList
is SubtypeIndication
s) =
    String -> Doc
text String
"FILE" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep ((Identifier -> Doc) -> IdentifierList -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
is) Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s

--instance Pretty InterfaceElement where pp = undefined

instance Pretty InterfaceList where
  pp :: GenericList -> Doc
pp (InterfaceList [InterfaceDeclaration]
es) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (InterfaceDeclaration -> Doc) -> [InterfaceDeclaration] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map InterfaceDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp [InterfaceDeclaration]
es

instance Pretty IterationScheme where
  pp :: IterationScheme -> Doc
pp (IterWhile Expression
c) = String -> Doc
text String
"WHILE" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
c
  pp (IterFor ParameterSpecification
p)   = String -> Doc
text String
"FOR" Doc -> Doc -> Doc
<+> ParameterSpecification -> Doc
forall a. Pretty a => a -> Doc
pp ParameterSpecification
p

--instance Pretty Label where pp = undefined

instance Pretty Letter where pp :: Letter -> Doc
pp = String -> Letter -> Doc
forall a. HasCallStack => String -> a
error String
"missing: Letter" -- todo

instance Pretty LetterOrDigit where pp :: LetterOrDigit -> Doc
pp = String -> LetterOrDigit -> Doc
forall a. HasCallStack => String -> a
error String
"missing: LetterOrDigit" -- todo

instance Pretty LibraryClause where
  pp :: LibraryClause -> Doc
pp (LibraryClause LogicalNameList
ns) = String -> Doc
text String
"LIBRARY" Doc -> Doc -> Doc
<+> LogicalNameList -> Doc
forall a. Pretty a => a -> Doc
pp LogicalNameList
ns Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty LibraryUnit where
  pp :: LibraryUnit -> Doc
pp (LibraryPrimary PrimaryUnit
p)   = PrimaryUnit -> Doc
forall a. Pretty a => a -> Doc
pp PrimaryUnit
p
  pp (LibrarySecondary SecondaryUnit
s) = SecondaryUnit -> Doc
forall a. Pretty a => a -> Doc
pp SecondaryUnit
s

instance Pretty Literal where
  pp :: Literal -> Doc
pp (LitNum NumericLiteral
n)       = NumericLiteral -> Doc
forall a. Pretty a => a -> Doc
pp NumericLiteral
n
  pp (LitEnum EnumerationLiteral
e)      = EnumerationLiteral -> Doc
forall a. Pretty a => a -> Doc
pp EnumerationLiteral
e
  pp (LitString OperatorSymbol
s)    = OperatorSymbol -> Doc
forall a. Pretty a => a -> Doc
pp OperatorSymbol
s
  pp (LitBitString BitStringLiteral
b) = BitStringLiteral -> Doc
forall a. Pretty a => a -> Doc
pp BitStringLiteral
b
  pp (Literal
LitNull)        = String -> Doc
text String
"NULL"

instance Pretty LogicalNameList where
  pp :: LogicalNameList -> Doc
pp (LogicalNameList IdentifierList
ns) = [Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Identifier -> Doc) -> IdentifierList -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
ns

instance Pretty LogicalOperator where
  pp :: LogicalOperator -> Doc
pp (LogicalOperator
And)  = String -> Doc
text String
"AND"
  pp (LogicalOperator
Or)   = String -> Doc
text String
"OR"
  pp (LogicalOperator
Nand) = String -> Doc
text String
"NAND"
  pp (LogicalOperator
Nor)  = String -> Doc
text String
"NOR"
  pp (LogicalOperator
Xor)  = String -> Doc
text String
"XOR"
  pp (LogicalOperator
Xnor) = String -> Doc
text String
"XNOR"

instance Pretty LoopStatement where
  pp :: LoopStatement -> Doc
pp (LoopStatement Maybe Identifier
l Maybe IterationScheme
i SequenceOfStatements
ss) =
    Maybe Identifier -> Doc -> Doc
forall a. Pretty a => Maybe a -> Doc -> Doc
labels Maybe Identifier
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
      [ ((Doc -> Doc) -> Maybe IterationScheme -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe IterationScheme
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"LOOP")
        Doc -> Doc -> Doc
`hangs` SequenceOfStatements -> Doc
forall a. Pretty a => [a] -> Doc
vpp SequenceOfStatements
ss
      , String -> Doc
text String
"END LOOP" Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Identifier
l Doc -> Doc -> Doc
<+> Doc
semi
      ]

instance Pretty MiscellaneousOperator where
  pp :: MiscellaneousOperator -> Doc
pp (MiscellaneousOperator
Exp) = String -> Doc
text String
"**"
  pp (MiscellaneousOperator
Abs) = String -> Doc
text String
"ABS"
  pp (MiscellaneousOperator
Not) = String -> Doc
text String
"NOT"

instance Pretty Mode where
  pp :: Mode -> Doc
pp (Mode
In)      = String -> Doc
text String
"IN"
  pp (Mode
Out)     = String -> Doc
text String
"OUT"
  pp (Mode
InOut)   = String -> Doc
text String
"INOUT"
  pp (Mode
Buffer)  = String -> Doc
text String
"BUFFER"
  pp (Mode
Linkage) = String -> Doc
text String
"LINKAGE"

instance Pretty MultiplyingOperator where
  pp :: MultiplyingOperator -> Doc
pp (MultiplyingOperator
Times) = Char -> Doc
char Char
'*'
  pp (MultiplyingOperator
Div)   = Char -> Doc
char Char
'/'
  pp (MultiplyingOperator
Mod)   = String -> Doc
text String
"MOD"
  pp (MultiplyingOperator
Rem)   = String -> Doc
text String
"REM"

instance Pretty Name where
  pp :: Name -> Doc
pp (NSimple Identifier
n) = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
n
  pp (NOp OperatorSymbol
o)     = OperatorSymbol -> Doc
forall a. Pretty a => a -> Doc
pp OperatorSymbol
o
  pp (NSelect SelectedName
s) = SelectedName -> Doc
forall a. Pretty a => a -> Doc
pp SelectedName
s
  pp (NIndex IndexedName
i)  = IndexedName -> Doc
forall a. Pretty a => a -> Doc
pp IndexedName
i
  pp (NSlice SliceName
s)  = SliceName -> Doc
forall a. Pretty a => a -> Doc
pp SliceName
s
  pp (NAttr AttributeName
a)   = AttributeName -> Doc
forall a. Pretty a => a -> Doc
pp AttributeName
a

instance Pretty NextStatement where
  pp :: NextStatement -> Doc
pp (NextStatement Maybe Identifier
l Maybe Identifier
b Maybe Expression
c) = Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> String -> Doc
text String
"NEXT" Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Identifier
b Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"WHEN") Maybe Expression
c Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty NullStatement where
  pp :: NullStatement -> Doc
pp (NullStatement Maybe Identifier
l) = Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> String -> Doc
text String
"NULL"

instance Pretty NumericLiteral where
  pp :: NumericLiteral -> Doc
pp (NLitAbstract AbstractLiteral
a) = AbstractLiteral -> Doc
forall a. Pretty a => a -> Doc
pp AbstractLiteral
a
  pp (NLitPhysical PhysicalLiteral
p) = PhysicalLiteral -> Doc
forall a. Pretty a => a -> Doc
pp PhysicalLiteral
p

instance Pretty ObjectDeclaration where
  pp :: ObjectDeclaration -> Doc
pp (ObjConst ConstantDeclaration
c) = ConstantDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ConstantDeclaration
c
  pp (ObjSig SignalDeclaration
s)   = SignalDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SignalDeclaration
s
  pp (ObjVar VariableDeclaration
v)   = VariableDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp VariableDeclaration
v
  pp (ObjFile FileDeclaration
f)  = FileDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp FileDeclaration
f

--instance Pretty OperatorSymbol where pp = undefined

instance Pretty Options where
  pp :: Options -> Doc
pp (Options Bool
g Maybe DelayMechanism
d) = Bool -> Doc -> Doc
when Bool
g (String -> Doc
text String
"GUARDED") Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe DelayMechanism -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe DelayMechanism
d

instance Pretty PackageBody where
  pp :: PackageBody -> Doc
pp (PackageBody Identifier
n PackageBodyDeclarativePart
d) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"PACKAGE BODY" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
n Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS"
         , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PackageBodyDeclarativePart -> Doc
forall a. Pretty a => a -> Doc
pp PackageBodyDeclarativePart
d
         , String -> Doc
text String
"END PACKAGE BODY" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
n Doc -> Doc -> Doc
<+> Doc
semi
         ]

instance Pretty PackageBodyDeclarativeItem where
  pp :: PackageBodyDeclarativeItem -> Doc
pp (PBDISubprogDecl SubprogramDeclaration
s) = SubprogramDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramDeclaration
s
  pp (PBDISubprogBody SubprogramBody
b) = SubprogramBody -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramBody
b
  pp (PBDIType TypeDeclaration
t)        = TypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp TypeDeclaration
t
  pp (PBDISubtype SubtypeDeclaration
s)     = SubtypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeDeclaration
s
  pp (PBDIConstant ConstantDeclaration
c)    = ConstantDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ConstantDeclaration
c
  pp (PBDIShared VariableDeclaration
s)      = VariableDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp VariableDeclaration
s
  pp (PBDIFile FileDeclaration
f)        = FileDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp FileDeclaration
f
  pp (PBDIAlias AliasDeclaration
a)       = AliasDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AliasDeclaration
a
  pp (PBDIUseClause UseClause
u)   = UseClause -> Doc
forall a. Pretty a => a -> Doc
pp UseClause
u
  pp (PBDIGroupTemp GroupTemplateDeclaration
g)   = GroupTemplateDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupTemplateDeclaration
g
  pp (PBDIGroup GroupDeclaration
g)       = GroupDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupDeclaration
g

--Instance Pretty PackageBodyDeclarativePart where pp = undefined

-- todo: like functions, this way of printing is a slight hack. To fix,
-- we have to make 'PackageDeclarativePart' a concrete data type and give
-- it a pretty printing instance.
instance Pretty PackageDeclaration where
  pp :: PackageDeclaration -> Doc
pp (PackageDeclaration Identifier
i PackageDeclarativePart
ds) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"PACKAGE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS"
         , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (PackageDeclarativeItem -> Doc) -> PackageDeclarativePart -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PackageDeclarativeItem -> Doc
forall a. Pretty a => a -> Doc
pp PackageDeclarativePart
ds
         , String -> Doc
text String
"END PACKAGE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> Doc
semi
         ]
{-
  pp (PackageDeclaration i d) =
    vcat [ text "PACKAGE" <+> pp i <+> text "IS"
         , indent $ pp d
         , text "END PACKAGE" <+> pp i <+> semi
         ]
-}

instance Pretty PackageDeclarativeItem where
  pp :: PackageDeclarativeItem -> Doc
pp (PHDISubprogDecl SubprogramDeclaration
s) = SubprogramDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramDeclaration
s
  pp (PHDISubprogBody SubprogramBody
b) = SubprogramBody -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramBody
b
  pp (PHDIType TypeDeclaration
t)        = TypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp TypeDeclaration
t
  pp (PHDISubtype SubtypeDeclaration
s)     = SubtypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeDeclaration
s
  pp (PHDIConstant ConstantDeclaration
c)    = ConstantDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ConstantDeclaration
c
  pp (PHDISignal SignalDeclaration
s)      = SignalDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SignalDeclaration
s
  pp (PHDIShared VariableDeclaration
v)      = VariableDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp VariableDeclaration
v
  pp (PHDIFile FileDeclaration
f)        = FileDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp FileDeclaration
f
  pp (PHDIAlias AliasDeclaration
a)       = AliasDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AliasDeclaration
a
  pp (PHDIComp ComponentDeclaration
c)        = ComponentDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ComponentDeclaration
c
  pp (PHDIAttrDecl AttributeDeclaration
a)    = AttributeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AttributeDeclaration
a
  pp (PHDIAttrSpec AttributeSpecification
a)    = AttributeSpecification -> Doc
forall a. Pretty a => a -> Doc
pp AttributeSpecification
a
  pp (PHDIDiscSpec DisconnectionSpecification
d)    = DisconnectionSpecification -> Doc
forall a. Pretty a => a -> Doc
pp DisconnectionSpecification
d
  pp (PHDIUseClause UseClause
u)   = UseClause -> Doc
forall a. Pretty a => a -> Doc
pp UseClause
u
  pp (PHDIGroupTemp GroupTemplateDeclaration
g)   = GroupTemplateDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupTemplateDeclaration
g
  pp (PHDIGroup GroupDeclaration
g)       = GroupDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupDeclaration
g
  
--instance Pretty PackageDeclarativePart where pp = undefined

instance Pretty ParameterSpecification where
  pp :: ParameterSpecification -> Doc
pp (ParameterSpecification Identifier
i DiscreteRange
r) = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"IN" Doc -> Doc -> Doc
<+> DiscreteRange -> Doc
forall a. Pretty a => a -> Doc
pp DiscreteRange
r

instance Pretty PhysicalLiteral where
  pp :: PhysicalLiteral -> Doc
pp (PhysicalLiteral Maybe Literal
a Name
n) = (Doc -> Doc) -> Maybe Literal -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Literal
a Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n

instance Pretty PhysicalTypeDefinition where
  pp :: PhysicalTypeDefinition -> Doc
pp (PhysicalTypeDefinition RangeConstraint
c Identifier
p [SecondaryUnitDeclaration]
s Maybe Identifier
n) =
    RangeConstraint -> Doc
forall a. Pretty a => a -> Doc
pp RangeConstraint
c Doc -> Doc -> Doc
`hangs` [Doc] -> Doc
vcat
      [ String -> Doc
text String
"UNITS"
      , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
        [ Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
p
        , [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (SecondaryUnitDeclaration -> Doc)
-> [SecondaryUnitDeclaration] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SecondaryUnitDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp [SecondaryUnitDeclaration]
s
        ]
      , String -> Doc
text String
"END UNITS" Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Identifier
n
      ]

instance Pretty PortClause where
  pp :: PortClause -> Doc
pp (PortClause GenericList
ls) = String -> Doc
text String
"PORT" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (GenericList -> Doc
forall a. Pretty a => a -> Doc
pp GenericList
ls) Doc -> Doc -> Doc
<+> Doc
semi

--instance Pretty PortList where pp = undefined

instance Pretty PortMapAspect where
  pp :: PortMapAspect -> Doc
pp (PortMapAspect AssociationList
as) = String -> Doc
text String
"PORT MAP" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (AssociationList -> Doc
forall a. Pretty a => a -> Doc
pp AssociationList
as) Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty Prefix where
  pp :: Prefix -> Doc
pp (PName Name
n) = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (PFun FunctionCall
f)  = FunctionCall -> Doc
forall a. Pretty a => a -> Doc
pp FunctionCall
f

instance Pretty Primary where
  pp :: Primary -> Doc
pp (PrimName Name
n)  = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (PrimLit Literal
l)   = Literal -> Doc
forall a. Pretty a => a -> Doc
pp Literal
l
  pp (PrimAgg Aggregate
a)   = Aggregate -> Doc
forall a. Pretty a => a -> Doc
pp Aggregate
a
  pp (PrimFun FunctionCall
f)   = FunctionCall -> Doc
forall a. Pretty a => a -> Doc
pp FunctionCall
f
  pp (PrimQual QualifiedExpression
q)  = QualifiedExpression -> Doc
forall a. Pretty a => a -> Doc
pp QualifiedExpression
q
  pp (PrimTCon TypeConversion
t)  = TypeConversion -> Doc
forall a. Pretty a => a -> Doc
pp TypeConversion
t
  pp (PrimAlloc Allocator
a) = Allocator -> Doc
forall a. Pretty a => a -> Doc
pp Allocator
a
  pp (PrimExp Expression
e)   = Doc -> Doc
parens (Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e)

instance Pretty PrimaryUnit where
  pp :: PrimaryUnit -> Doc
pp (PrimaryEntity EntityDeclaration
e)  = EntityDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp EntityDeclaration
e
  pp (PrimaryConfig ConfigurationDeclaration
c)  = ConfigurationDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ConfigurationDeclaration
c
  pp (PrimaryPackage PackageDeclaration
p) = PackageDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp PackageDeclaration
p

instance Pretty ProcedureCall where
  pp :: ProcedureCall -> Doc
pp (ProcedureCall Name
n Maybe AssociationList
ap) = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe AssociationList -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
parens Maybe AssociationList
ap

instance Pretty ProcedureCallStatement where
  pp :: ProcedureCallStatement -> Doc
pp (ProcedureCallStatement Maybe Identifier
l ProcedureCall
p) = Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> ProcedureCall -> Doc
forall a. Pretty a => a -> Doc
pp ProcedureCall
p Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty ProcessDeclarativeItem where
  pp :: ProcessDeclarativeItem -> Doc
pp (PDISubprogDecl SubprogramDeclaration
s) = SubprogramDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramDeclaration
s
  pp (PDISubprogBody SubprogramBody
b) = SubprogramBody -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramBody
b
  pp (PDIType TypeDeclaration
t)        = TypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp TypeDeclaration
t
  pp (PDISubtype SubtypeDeclaration
s)     = SubtypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeDeclaration
s
  pp (PDIConstant ConstantDeclaration
c)    = ConstantDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ConstantDeclaration
c
  pp (PDIVariable VariableDeclaration
v)    = VariableDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp VariableDeclaration
v
  pp (PDIFile FileDeclaration
f)        = FileDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp FileDeclaration
f
  pp (PDIAlias AliasDeclaration
a)       = AliasDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AliasDeclaration
a
  pp (PDIAttrDecl AttributeDeclaration
a)    = AttributeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AttributeDeclaration
a
  pp (PDIAttrSpec AttributeSpecification
a)    = AttributeSpecification -> Doc
forall a. Pretty a => a -> Doc
pp AttributeSpecification
a
  pp (PDIUseClause UseClause
u)   = UseClause -> Doc
forall a. Pretty a => a -> Doc
pp UseClause
u

--instance Pretty ProcessDeclarativePart where pp = undefined

instance Pretty ProcessStatement where
  pp :: ProcessStatement -> Doc
pp (ProcessStatement Maybe Identifier
l Bool
p Maybe SensitivityList
ss ProcessDeclarativePart
d SequenceOfStatements
s) =
    Maybe Identifier -> Doc -> Doc
forall a. Pretty a => Maybe a -> Doc -> Doc
labels Maybe Identifier
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
      [ (Doc
post Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe SensitivityList -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
parens Maybe SensitivityList
ss Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS")
        Doc -> Doc -> Doc
`hangs` ProcessDeclarativePart -> Doc
forall a. Pretty a => [a] -> Doc
vpp ProcessDeclarativePart
d
      , String -> Doc
text String
"BEGIN"
        Doc -> Doc -> Doc
`hangs` SequenceOfStatements -> Doc
forall a. Pretty a => [a] -> Doc
vpp SequenceOfStatements
s
      , String -> Doc
text String
"END" Doc -> Doc -> Doc
<+> Doc
post Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Identifier
l Doc -> Doc -> Doc
<+> Doc
semi
      ]
    where
      post :: Doc
post = Bool -> Doc -> Doc
when Bool
p (String -> Doc
text String
"POSTPONED") Doc -> Doc -> Doc
<+> String -> Doc
text String
"PROCESS"

--instance Pretty ProcessStatementPart where pp = undefined

instance Pretty QualifiedExpression where
  pp :: QualifiedExpression -> Doc
pp (QualExp TypeMark
t Expression
e) = TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e)
  pp (QualAgg TypeMark
t Aggregate
a) = TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<+> Aggregate -> Doc
forall a. Pretty a => a -> Doc
pp Aggregate
a

instance Pretty Range where
  pp :: Range -> Doc
pp (RAttr AttributeName
a)       = AttributeName -> Doc
forall a. Pretty a => a -> Doc
pp AttributeName
a
  pp (RSimple SimpleExpression
l Direction
d SimpleExpression
u) = SimpleExpression -> Doc
forall a. Pretty a => a -> Doc
pp SimpleExpression
l Doc -> Doc -> Doc
<+> Direction -> Doc
forall a. Pretty a => a -> Doc
pp Direction
d Doc -> Doc -> Doc
<+> SimpleExpression -> Doc
forall a. Pretty a => a -> Doc
pp SimpleExpression
u

instance Pretty RangeConstraint where
  pp :: RangeConstraint -> Doc
pp (RangeConstraint Range
r) = String -> Doc
text String
"RANGE" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. Pretty a => a -> Doc
pp Range
r

instance Pretty RecordTypeDefinition where
  pp :: RecordTypeDefinition -> Doc
pp (RecordTypeDefinition [ElementDeclaration]
es Maybe Identifier
n) =
    [Doc] -> Doc
vcat [ String -> Doc
text String
"RECORD"
         , [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ElementDeclaration -> Doc) -> [ElementDeclaration] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ElementDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp [ElementDeclaration]
es
         , String -> Doc
text String
"END RECORD" Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe Identifier -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Identifier
n
         ]

instance Pretty Relation where
  pp :: Relation -> Doc
pp (Relation ShiftExpression
e (Maybe (RelationalOperator, ShiftExpression)
Nothing))     = ShiftExpression -> Doc
forall a. Pretty a => a -> Doc
pp ShiftExpression
e
  pp (Relation ShiftExpression
e (Just (RelationalOperator
r, ShiftExpression
s))) = ShiftExpression -> Doc
forall a. Pretty a => a -> Doc
pp ShiftExpression
e Doc -> Doc -> Doc
<+> RelationalOperator -> Doc
forall a. Pretty a => a -> Doc
pp RelationalOperator
r Doc -> Doc -> Doc
<+> ShiftExpression -> Doc
forall a. Pretty a => a -> Doc
pp ShiftExpression
s

instance Pretty RelationalOperator where
  pp :: RelationalOperator -> Doc
pp (RelationalOperator
Eq)  = Doc
equals
  pp (RelationalOperator
Neq) = String -> Doc
text String
"/="
  pp (RelationalOperator
Lt)  = Char -> Doc
char Char
'<'
  pp (RelationalOperator
Lte) = String -> Doc
text String
"<="
  pp (RelationalOperator
Gt)  = Char -> Doc
char Char
'>'
  pp (RelationalOperator
Gte) = String -> Doc
text String
">="

instance Pretty ReportStatement where
  pp :: ReportStatement -> Doc
pp (ReportStatement Maybe Identifier
l Expression
e Maybe Expression
s) =
    Maybe Identifier -> Doc -> Doc
forall a. Pretty a => Maybe a -> Doc -> Doc
labels Maybe Identifier
l (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc
text String
"REPORT" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e Doc -> Doc -> Doc
`hangs` Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"SEVERITY") Maybe Expression
s) Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty ReturnStatement where
  pp :: ReturnStatement -> Doc
pp (ReturnStatement Maybe Identifier
l Maybe Expression
e) = Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> String -> Doc
text String
"RETURN" Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condR Doc
semi Maybe Expression
e

instance Pretty ScalarTypeDefinition where
  pp :: ScalarTypeDefinition -> Doc
pp (ScalarEnum EnumerationTypeDefinition
e)  = EnumerationTypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp EnumerationTypeDefinition
e
  pp (ScalarInt RangeConstraint
i)   = RangeConstraint -> Doc
forall a. Pretty a => a -> Doc
pp RangeConstraint
i
  pp (ScalarFloat RangeConstraint
f) = RangeConstraint -> Doc
forall a. Pretty a => a -> Doc
pp RangeConstraint
f
  pp (ScalarPhys PhysicalTypeDefinition
p)  = PhysicalTypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp PhysicalTypeDefinition
p

instance Pretty SecondaryUnit where
  pp :: SecondaryUnit -> Doc
pp (SecondaryArchitecture ArchitectureBody
a) = ArchitectureBody -> Doc
forall a. Pretty a => a -> Doc
pp ArchitectureBody
a
  pp (SecondaryPackage PackageBody
p)      = PackageBody -> Doc
forall a. Pretty a => a -> Doc
pp PackageBody
p

instance Pretty SecondaryUnitDeclaration where
  pp :: SecondaryUnitDeclaration -> Doc
pp (SecondaryUnitDeclaration Identifier
i PhysicalLiteral
p) = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> PhysicalLiteral -> Doc
forall a. Pretty a => a -> Doc
pp PhysicalLiteral
p

instance Pretty SelectedName where
  pp :: SelectedName -> Doc
pp (SelectedName Prefix
p Suffix
s) = Prefix -> Doc
forall a. Pretty a => a -> Doc
pp Prefix
p Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> Suffix -> Doc
forall a. Pretty a => a -> Doc
pp Suffix
s

instance Pretty SelectedSignalAssignment where
  pp :: SelectedSignalAssignment -> Doc
pp (SelectedSignalAssignment Expression
e Target
t Options
o SelectedWaveforms
w) =
    String -> Doc
text String
"WITH" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e Doc -> Doc -> Doc
<+> String -> Doc
text String
"SELECT"
      Doc -> Doc -> Doc
`hangs`
    Target -> Doc
forall a. Pretty a => a -> Doc
pp Target
t Doc -> Doc -> Doc
<+> String -> Doc
text String
"<=" Doc -> Doc -> Doc
<+> Options -> Doc
forall a. Pretty a => a -> Doc
pp Options
o Doc -> Doc -> Doc
<+> SelectedWaveforms -> Doc
forall a. Pretty a => a -> Doc
pp SelectedWaveforms
w Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty SelectedWaveforms where
  pp :: SelectedWaveforms -> Doc
pp (SelectedWaveforms Maybe [(Waveform, Choices)]
ws (Waveform
w, Choices
c)) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
optional [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
last]
    where
      optional :: [Doc]
optional = [Doc]
-> ([(Waveform, Choices)] -> [Doc])
-> Maybe [(Waveform, Choices)]
-> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (((Waveform, Choices) -> Doc) -> [(Waveform, Choices)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Waveform, Choices) -> Doc
forall a a. (Pretty a, Pretty a) => (a, a) -> Doc
f) Maybe [(Waveform, Choices)]
ws
      last :: Doc
last     = Waveform -> Doc
forall a. Pretty a => a -> Doc
pp Waveform
w Doc -> Doc -> Doc
<+> String -> Doc
text String
"WHEN" Doc -> Doc -> Doc
<+> Choices -> Doc
forall a. Pretty a => a -> Doc
pp Choices
c
      f :: (a, a) -> Doc
f (a
w, a
c) = a -> Doc
forall a. Pretty a => a -> Doc
pp a
w Doc -> Doc -> Doc
<+> String -> Doc
text String
"WHEN" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pp a
c Doc -> Doc -> Doc
<+> Doc
comma

instance Pretty SensitivityClause where
  pp :: SensitivityClause -> Doc
pp (SensitivityClause SensitivityList
ss) = String -> Doc
text String
"ON" Doc -> Doc -> Doc
<+> SensitivityList -> Doc
forall a. Pretty a => a -> Doc
pp SensitivityList
ss

instance Pretty SensitivityList where
  pp :: SensitivityList -> Doc
pp (SensitivityList [Name]
ns) = [Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Pretty a => a -> Doc
pp [Name]
ns

--instance Pretty SequenceOfStatements where pp = undefined

instance Pretty SequentialStatement where
  pp :: SequentialStatement -> Doc
pp (SWait WaitStatement
w)      = WaitStatement -> Doc
forall a. Pretty a => a -> Doc
pp WaitStatement
w
  pp (SAssert AssertionStatement
a)    = AssertionStatement -> Doc
forall a. Pretty a => a -> Doc
pp AssertionStatement
a
  pp (SReport ReportStatement
r)    = ReportStatement -> Doc
forall a. Pretty a => a -> Doc
pp ReportStatement
r
  pp (SSignalAss SignalAssignmentStatement
s) = SignalAssignmentStatement -> Doc
forall a. Pretty a => a -> Doc
pp SignalAssignmentStatement
s
  pp (SVarAss VariableAssignmentStatement
v)    = VariableAssignmentStatement -> Doc
forall a. Pretty a => a -> Doc
pp VariableAssignmentStatement
v
  pp (SProc ProcedureCallStatement
p)      = ProcedureCallStatement -> Doc
forall a. Pretty a => a -> Doc
pp ProcedureCallStatement
p
  pp (SIf IfStatement
i)        = IfStatement -> Doc
forall a. Pretty a => a -> Doc
pp IfStatement
i
  pp (SCase CaseStatement
c)      = CaseStatement -> Doc
forall a. Pretty a => a -> Doc
pp CaseStatement
c
  pp (SLoop LoopStatement
l)      = LoopStatement -> Doc
forall a. Pretty a => a -> Doc
pp LoopStatement
l
  pp (SNext NextStatement
n)      = NextStatement -> Doc
forall a. Pretty a => a -> Doc
pp NextStatement
n
  pp (SExit ExitStatement
e)      = ExitStatement -> Doc
forall a. Pretty a => a -> Doc
pp ExitStatement
e
  pp (SReturn ReturnStatement
r)    = ReturnStatement -> Doc
forall a. Pretty a => a -> Doc
pp ReturnStatement
r
  pp (SNull NullStatement
n)      = NullStatement -> Doc
forall a. Pretty a => a -> Doc
pp NullStatement
n

instance Pretty ShiftExpression where
  pp :: ShiftExpression -> Doc
pp (ShiftExpression SimpleExpression
e (Maybe (ShiftOperator, SimpleExpression)
Nothing))     = SimpleExpression -> Doc
forall a. Pretty a => a -> Doc
pp SimpleExpression
e
  pp (ShiftExpression SimpleExpression
e (Just (ShiftOperator
r, SimpleExpression
s))) = SimpleExpression -> Doc
forall a. Pretty a => a -> Doc
pp SimpleExpression
e Doc -> Doc -> Doc
<+> ShiftOperator -> Doc
forall a. Pretty a => a -> Doc
pp ShiftOperator
r Doc -> Doc -> Doc
<+> SimpleExpression -> Doc
forall a. Pretty a => a -> Doc
pp SimpleExpression
s

instance Pretty ShiftOperator where
  pp :: ShiftOperator -> Doc
pp ShiftOperator
Sll = String -> Doc
text String
"SLL"
  pp ShiftOperator
Srl = String -> Doc
text String
"SRL"
  pp ShiftOperator
Sla = String -> Doc
text String
"SLA"
  pp ShiftOperator
Sra = String -> Doc
text String
"SRA"
  pp ShiftOperator
Rol = String -> Doc
text String
"ROL"
  pp ShiftOperator
Ror = String -> Doc
text String
"ROR"

instance Pretty Sign where
  pp :: Sign -> Doc
pp Sign
Identity = Char -> Doc
char Char
'+'
  pp Sign
Negation = Char -> Doc
char Char
'-'

instance Pretty SignalAssignmentStatement where
  pp :: SignalAssignmentStatement -> Doc
pp (SignalAssignmentStatement Maybe Identifier
l Target
t Maybe DelayMechanism
d Waveform
w) =
        Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> Target -> Doc
forall a. Pretty a => a -> Doc
pp Target
t Doc -> Doc -> Doc
<+> String -> Doc
text String
"<="
    Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe DelayMechanism -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond  Doc -> Doc
forall a. a -> a
id    Maybe DelayMechanism
d Doc -> Doc -> Doc
<+> Waveform -> Doc
forall a. Pretty a => a -> Doc
pp Waveform
w Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty SignalDeclaration where
  pp :: SignalDeclaration -> Doc
pp (SignalDeclaration IdentifierList
is SubtypeIndication
s Maybe SignalKind
k Maybe Expression
e) =
        String -> Doc
text String
"SIGNAL"
    Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep ((Identifier -> Doc) -> IdentifierList -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
is)
    Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s {-<+> cond id k-}
    Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
":=") Maybe Expression
e Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty SignalKind where
  pp :: SignalKind -> Doc
pp SignalKind
Register = String -> Doc
text String
"REGISTER"
  pp SignalKind
Bus      = String -> Doc
text String
"BUS"

instance Pretty SignalList where
  pp :: SignalList -> Doc
pp (SLName [Name]
ns) = [Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Pretty a => a -> Doc
pp [Name]
ns
  pp (SignalList
SLOthers)  = String -> Doc
text String
"OTHERS"
  pp (SignalList
SLAll)     = String -> Doc
text String
"ALL"

instance Pretty Signature where
  pp :: Signature -> Doc
pp (Signature (Maybe (Maybe [TypeMark], Maybe TypeMark)
Nothing))      = Doc
empty
  pp (Signature (Just (Maybe [TypeMark]
ts, Maybe TypeMark
t))) = Doc
init Doc -> Doc -> Doc
<+> Doc -> Maybe TypeMark -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"RETURN") Maybe TypeMark
t
    where
      init :: Doc
init = [Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> ([TypeMark] -> [Doc]) -> Maybe [TypeMark] -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((TypeMark -> Doc) -> [TypeMark] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp) Maybe [TypeMark]
ts

instance Pretty SimpleExpression where
  pp :: SimpleExpression -> Doc
pp (SimpleExpression Maybe Sign
s Term
t [(AddingOperator, Term)]
as) = (Doc -> Doc) -> Maybe Sign -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id Maybe Sign
s Doc -> Doc -> Doc
<+> Term -> Doc
forall a. Pretty a => a -> Doc
pp Term
t Doc -> Doc -> Doc
<+> Doc
adds
    where
      adds :: Doc
adds = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((AddingOperator, Term) -> Doc)
-> [(AddingOperator, Term)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(AddingOperator
a, Term
t) -> AddingOperator -> Doc
forall a. Pretty a => a -> Doc
pp AddingOperator
a Doc -> Doc -> Doc
<+> Term -> Doc
forall a. Pretty a => a -> Doc
pp Term
t) [(AddingOperator, Term)]
as

--instance Pretty SimpleName where pp = undefined

instance Pretty SliceName where
  pp :: SliceName -> Doc
pp (SliceName Prefix
p DiscreteRange
r) = Prefix -> Doc
forall a. Pretty a => a -> Doc
pp Prefix
p Doc -> Doc -> Doc
<+> Doc -> Doc
parens (DiscreteRange -> Doc
forall a. Pretty a => a -> Doc
pp DiscreteRange
r)

instance Pretty StringLiteral where
  pp :: OperatorSymbol -> Doc
pp (SLit String
s) = Char -> Doc
char Char
'\"' Doc -> Doc -> Doc
<> String -> Doc
text String
s Doc -> Doc -> Doc
<> Char -> Doc
char Char
'\"'

instance Pretty SubprogramBody where
  pp :: SubprogramBody -> Doc
pp (SubprogramBody SubprogramSpecification
s SubprogramDeclarativePart
d SequenceOfStatements
st Maybe SubprogramKind
k Maybe Designator
de) =
    [Doc] -> Doc
vcat [ SubprogramSpecification -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramSpecification
s Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS"
         , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ SubprogramDeclarativePart -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramDeclarativePart
d
         , String -> Doc
text String
"BEGIN"
         , Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ SequenceOfStatements -> Doc
forall a. Pretty a => a -> Doc
pp SequenceOfStatements
st
         , String -> Doc
text String
"END" Doc -> Doc -> Doc
<+> Maybe SubprogramKind -> Doc
forall a. Pretty a => Maybe a -> Doc
pp' Maybe SubprogramKind
k Doc -> Doc -> Doc
<+> Maybe Designator -> Doc
forall a. Pretty a => Maybe a -> Doc
pp' Maybe Designator
de Doc -> Doc -> Doc
<+> Doc
semi
         ]

--instance Pretty SubprogramDeclaration where pp = undefined

instance Pretty SubprogramDeclarativeItem where
  pp :: SubprogramDeclarativeItem -> Doc
pp (SDISubprogDecl SubprogramDeclaration
d) = SubprogramDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramDeclaration
d
  pp (SDISubprogBody SubprogramBody
b) = SubprogramBody -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramBody
b
  pp (SDIType TypeDeclaration
t)        = TypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp TypeDeclaration
t
  pp (SDISubtype SubtypeDeclaration
s)     = SubtypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeDeclaration
s
  pp (SDIConstant ConstantDeclaration
c)    = ConstantDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp ConstantDeclaration
c
  pp (SDIVariable VariableDeclaration
v)    = VariableDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp VariableDeclaration
v
  pp (SDIFile FileDeclaration
f)        = FileDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp FileDeclaration
f
  pp (SDIAlias AliasDeclaration
a)       = AliasDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AliasDeclaration
a
  pp (SDIAttrDecl AttributeDeclaration
a)    = AttributeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp AttributeDeclaration
a
  pp (SDIAttrSepc AttributeSpecification
a)    = AttributeSpecification -> Doc
forall a. Pretty a => a -> Doc
pp AttributeSpecification
a
  pp (SDIUseClause UseClause
u)   = UseClause -> Doc
forall a. Pretty a => a -> Doc
pp UseClause
u
  pp (SDIGroupTemp GroupTemplateDeclaration
g)   = GroupTemplateDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupTemplateDeclaration
g
  pp (SDIGroup GroupDeclaration
g)       = GroupDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp GroupDeclaration
g

--instance Pretty SubprogramDeclarativePart where pp = undefined

instance Pretty SubprogramKind where
  pp :: SubprogramKind -> Doc
pp SubprogramKind
Procedure = String -> Doc
text String
"PROCEDURE"
  pp SubprogramKind
Function  = String -> Doc
text String
"FUNCTION"

instance Pretty SubprogramSpecification where
  pp :: SubprogramSpecification -> Doc
pp (SubprogramProcedure Designator
d Maybe GenericList
fs)    = String -> Doc
text String
"PROCEDURE" Doc -> Doc -> Doc
<+> Designator -> Doc
forall a. Pretty a => a -> Doc
pp Designator
d Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe GenericList -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
parens Maybe GenericList
fs
  pp (SubprogramFunction Maybe Bool
p Designator
d Maybe GenericList
fs TypeMark
t) =
      Doc
purity Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat
        [ String -> Doc
text String
"FUNCTION" Doc -> Doc -> Doc
<+> Designator -> Doc
forall a. Pretty a => a -> Doc
pp Designator
d Doc -> Doc -> Doc
<+> (Doc -> Doc) -> Maybe GenericList -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
parens Maybe GenericList
fs
        , String -> Doc
text String
"RETURN"   Doc -> Doc -> Doc
<+> TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t
        ]
    where
      purity :: Doc
purity = case Maybe Bool
p of
        Maybe Bool
Nothing    -> Doc
empty
        Just Bool
True  -> String -> Doc
text String
"PURE"
        Just Bool
False -> String -> Doc
text String
"IMPURE"

instance Pretty SubprogramDeclaration where
  pp :: SubprogramDeclaration -> Doc
pp (SubprogramDeclaration SubprogramSpecification
s) = SubprogramSpecification -> Doc
forall a. Pretty a => a -> Doc
pp SubprogramSpecification
s Doc -> Doc -> Doc
<+> Doc
semi

--instance Pretty SubprogramStatementPart where pp = undefined

instance Pretty SubtypeDeclaration where
  pp :: SubtypeDeclaration -> Doc
pp (SubtypeDeclaration Identifier
i SubtypeIndication
s) = String -> Doc
text String
"SUBTYPE" Doc -> Doc -> Doc
<+> Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"IS" Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty SubtypeIndication where
  pp :: SubtypeIndication -> Doc
pp (SubtypeIndication Maybe Name
n TypeMark
t Maybe Constraint
c) = Maybe Name -> Doc
forall a. Pretty a => Maybe a -> Doc
pp' Maybe Name
n Doc -> Doc -> Doc
<+> TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t Doc -> Doc -> Doc
<+> Maybe Constraint -> Doc
forall a. Pretty a => Maybe a -> Doc
pp' Maybe Constraint
c

instance Pretty Suffix where
  pp :: Suffix -> Doc
pp (SSimple Identifier
n) = Identifier -> Doc
forall a. Pretty a => a -> Doc
pp Identifier
n
  pp (SChar CharacterLiteral
c)   = CharacterLiteral -> Doc
forall a. Pretty a => a -> Doc
pp CharacterLiteral
c
  pp (SOp OperatorSymbol
o)     = OperatorSymbol -> Doc
forall a. Pretty a => a -> Doc
pp OperatorSymbol
o
  pp (Suffix
SAll)      = String -> Doc
text String
"ALL"

instance Pretty Target where
  pp :: Target -> Doc
pp (TargetName Name
n) = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (TargetAgg Aggregate
a)  = Aggregate -> Doc
forall a. Pretty a => a -> Doc
pp Aggregate
a

instance Pretty Term where
  pp :: Term -> Doc
pp (Term Factor
f [(MultiplyingOperator, Factor)]
ms) = Factor -> Doc
forall a. Pretty a => a -> Doc
pp Factor
f Doc -> Doc -> Doc
<+> Doc
muls
    where
      muls :: Doc
muls = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((MultiplyingOperator, Factor) -> Doc)
-> [(MultiplyingOperator, Factor)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(MultiplyingOperator
m, Factor
t) -> MultiplyingOperator -> Doc
forall a. Pretty a => a -> Doc
pp MultiplyingOperator
m Doc -> Doc -> Doc
<+> Factor -> Doc
forall a. Pretty a => a -> Doc
pp Factor
t) [(MultiplyingOperator, Factor)]
ms

instance Pretty TimeoutClause where
  pp :: TimeoutClause -> Doc
pp (TimeoutClause Expression
e) = String -> Doc
text String
"FOR" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e

instance Pretty TypeConversion where
  pp :: TypeConversion -> Doc
pp (TypeConversion TypeMark
t Expression
e) = TypeMark -> Doc
forall a. Pretty a => a -> Doc
pp TypeMark
t Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e)

instance Pretty TypeDeclaration where
  pp :: TypeDeclaration -> Doc
pp (TDFull FullTypeDeclaration
ft)    = FullTypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp FullTypeDeclaration
ft
  pp (TDPartial IncompleteTypeDeclaration
pt) = IncompleteTypeDeclaration -> Doc
forall a. Pretty a => a -> Doc
pp IncompleteTypeDeclaration
pt

instance Pretty TypeDefinition where
  pp :: TypeDefinition -> Doc
pp (TDScalar ScalarTypeDefinition
s)    = ScalarTypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp ScalarTypeDefinition
s
  pp (TDComposite CompositeTypeDefinition
c) = CompositeTypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp CompositeTypeDefinition
c
  pp (TDAccess AccessTypeDefinition
a)    = AccessTypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp AccessTypeDefinition
a
  pp (TDFile FileTypeDefinition
f)      = FileTypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp FileTypeDefinition
f

instance Pretty TypeMark where
  pp :: TypeMark -> Doc
pp (TMType Name
n)    = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n
  pp (TMSubtype Name
n) = Name -> Doc
forall a. Pretty a => a -> Doc
pp Name
n

instance Pretty UnconstrainedArrayDefinition where
  pp :: UnconstrainedArrayDefinition -> Doc
pp (UnconstrainedArrayDefinition [IndexSubtypeDefinition]
is SubtypeIndication
s) =
    String -> Doc
text String
"ARRAY" Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (IndexSubtypeDefinition -> Doc)
-> [IndexSubtypeDefinition] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map IndexSubtypeDefinition -> Doc
forall a. Pretty a => a -> Doc
pp [IndexSubtypeDefinition]
is) Doc -> Doc -> Doc
<+> String -> Doc
text String
"OF" Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
s

instance Pretty UseClause where
  pp :: UseClause -> Doc
pp (UseClause [SelectedName]
ns) = String -> Doc
text String
"USE" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep ((SelectedName -> Doc) -> [SelectedName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SelectedName -> Doc
forall a. Pretty a => a -> Doc
pp [SelectedName]
ns) Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty VariableAssignmentStatement where
  pp :: VariableAssignmentStatement -> Doc
pp (VariableAssignmentStatement Maybe Identifier
l Target
t Expression
e) = Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> Target -> Doc
forall a. Pretty a => a -> Doc
pp Target
t Doc -> Doc -> Doc
<+> String -> Doc
text String
":=" Doc -> Doc -> Doc
<+> Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty VariableDeclaration where
  pp :: VariableDeclaration -> Doc
pp (VariableDeclaration Bool
s IdentifierList
is SubtypeIndication
sub Maybe Expression
e) =
    Bool -> Doc -> Doc
when Bool
s (String -> Doc
text String
"SHARED") Doc -> Doc -> Doc
<+> String -> Doc
text String
"VARIABLE"
    Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep ((Identifier -> Doc) -> IdentifierList -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Doc
forall a. Pretty a => a -> Doc
pp IdentifierList
is)
    Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> SubtypeIndication -> Doc
forall a. Pretty a => a -> Doc
pp SubtypeIndication
sub Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
":=") Maybe Expression
e Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty WaitStatement where
  pp :: WaitStatement -> Doc
pp (WaitStatement Maybe Identifier
l Maybe SensitivityClause
sc Maybe ConditionClause
cc Maybe TimeoutClause
tc) =
    Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> String -> Doc
text String
"WAIT" Doc -> Doc -> Doc
<+> Maybe SensitivityClause -> Doc
forall a. Pretty a => Maybe a -> Doc
pp' Maybe SensitivityClause
sc Doc -> Doc -> Doc
<+> Maybe ConditionClause -> Doc
forall a. Pretty a => Maybe a -> Doc
pp' Maybe ConditionClause
cc Doc -> Doc -> Doc
<+> Maybe TimeoutClause -> Doc
forall a. Pretty a => Maybe a -> Doc
pp' Maybe TimeoutClause
tc Doc -> Doc -> Doc
<+> Doc
semi

instance Pretty Waveform where
  pp :: Waveform -> Doc
pp (WaveElem [WaveformElement]
es)    = [Doc] -> Doc
commaSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (WaveformElement -> Doc) -> [WaveformElement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map WaveformElement -> Doc
forall a. Pretty a => a -> Doc
pp [WaveformElement]
es
  pp (Waveform
WaveUnaffected) = String -> Doc
text String
"UNAFFECTED"

instance Pretty WaveformElement where
  pp :: WaveformElement -> Doc
pp (WaveEExp Expression
e Maybe Expression
te) = Expression -> Doc
forall a. Pretty a => a -> Doc
pp Expression
e Doc -> Doc -> Doc
<+> Doc -> Maybe Expression -> Doc
forall a. Pretty a => Doc -> Maybe a -> Doc
condL (String -> Doc
text String
"AFTER") Maybe Expression
te

--------------------------------------------------------------------------------
-- * Some helpers
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- text sep.
  
commaSep  :: [Doc] -> Doc
commaSep :: [Doc] -> Doc
commaSep  = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

semiSep   :: [Doc] -> Doc
semiSep :: [Doc] -> Doc
semiSep   = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
semi

pipeSep   :: [Doc] -> Doc
pipeSep :: [Doc] -> Doc
pipeSep   = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
'|')

textSep   :: String -> [Doc] -> Doc
textSep :: String -> [Doc] -> Doc
textSep String
s = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (Doc
space Doc -> Doc -> Doc
<> String -> Doc
text String
s)

--------------------------------------------------------------------------------
-- indentation

indent :: Doc -> Doc
indent :: Doc -> Doc
indent = Int -> Doc -> Doc
nest Int
4

hangs  :: Doc -> Doc -> Doc
hangs :: Doc -> Doc -> Doc
hangs Doc
d1 Doc
d2 = Doc
d1 Doc -> Doc -> Doc
$+$ Doc -> Doc
indent Doc
d2

labels  :: Pretty a => Maybe a -> Doc -> Doc
labels :: Maybe a -> Doc -> Doc
labels (Maybe a
Nothing) Doc
doc = Doc
doc
labels (Just a
a)  Doc
doc = (a -> Doc
forall a. Pretty a => a -> Doc
pp a
a Doc -> Doc -> Doc
<+> Doc
colon) Doc -> Doc -> Doc
`hangs` Doc
doc

--------------------------------------------------------------------------------
-- conditional print

cond :: Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond :: (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
f = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
f (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
pp)

condR :: Pretty a => Doc -> Maybe a -> Doc
condR :: Doc -> Maybe a -> Doc
condR Doc
s = (Doc -> Doc) -> Maybe a -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond (Doc -> Doc -> Doc
<+> Doc
s)

condL :: Pretty a => Doc -> Maybe a -> Doc
condL :: Doc -> Maybe a -> Doc
condL Doc
s = (Doc -> Doc) -> Maybe a -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond (Doc
s Doc -> Doc -> Doc
<+>)

label :: Pretty a => Maybe a -> Doc
label :: Maybe a -> Doc
label = (Doc -> Doc) -> Maybe a -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond (Doc -> Doc -> Doc
<+> Doc
colon)

pp' :: Pretty a => Maybe a -> Doc
pp' :: Maybe a -> Doc
pp' = (Doc -> Doc) -> Maybe a -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
forall a. a -> a
id

parens' :: Pretty a => Maybe a -> Doc
parens' :: Maybe a -> Doc
parens' = (Doc -> Doc) -> Maybe a -> Doc
forall a. Pretty a => (Doc -> Doc) -> Maybe a -> Doc
cond Doc -> Doc
parens

when :: Bool -> Doc -> Doc
when :: Bool -> Doc -> Doc
when Bool
b Doc
a = if Bool
b then Doc
a else Doc
empty

--------------------------------------------------------------------------------
-- some common things

vpp :: Pretty a => [a] -> Doc
vpp :: [a] -> Doc
vpp = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($+$) Doc
empty ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pp

postponed :: Pretty a => Maybe Label -> Bool -> a -> Doc
postponed :: Maybe Identifier -> Bool -> a -> Doc
postponed Maybe Identifier
l Bool
b a
a = Maybe Identifier -> Doc
forall a. Pretty a => Maybe a -> Doc
label Maybe Identifier
l Doc -> Doc -> Doc
<+> Bool -> Doc -> Doc
when Bool
b (String -> Doc
text String
"POSTPONED") Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pp a
a

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