{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Demangler.Structure
where

import Data.List.NonEmpty ( NonEmpty )
import Data.Text ( Text )
import Numeric.Natural

import Demangler.Context

-- | The Demangled data structure holds the demangled name in data-oriented
-- format.  This format encodes the various roles and portions of the mangled
-- name in an AST-like structure that closely matches the mangled specification.
-- Unfortunately, this is a relatively messy representation that is not easy to
-- work with, and where things that might seem simple (e.g. the base function
-- name) can be encoded in a number of different ways.  Therefore, the details of
-- this structure are not exported and it should either be rendered to printable
-- version via the 'sayable' package or inspected via accessor functions (like
-- 'functionName').

data Demangled = Original Coord
               | Encoded Encoding
               | VendorExtended Encoding Coord


data Encoding = EncFunc FunctionName (Maybe Type_) (NonEmpty Type_)
              | EncStaticFunc FunctionName (Maybe Type_) (NonEmpty Type_)
              | EncData Name
              | EncSpecial SpecialName
              | EncConstStructData UnqualifiedName
                -- ^ Const data that is not a builtin data type.  Undocumented.
                --
                --  struct foo { int x; };
                --  const struct foo = { 9 };
                --
                -- or:
                --
                --  class foo { int x; };
                --  const class foo = { 9 };
                --
                -- Is encoded as _ZLname where name is the size followed by that
                -- many characters (e.g. _ZL3foo).
  deriving (Encoding -> Encoding -> Bool
(Encoding -> Encoding -> Bool)
-> (Encoding -> Encoding -> Bool) -> Eq Encoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Encoding -> Encoding -> Bool
== :: Encoding -> Encoding -> Bool
$c/= :: Encoding -> Encoding -> Bool
/= :: Encoding -> Encoding -> Bool
Eq, Int -> Encoding -> ShowS
[Encoding] -> ShowS
Encoding -> String
(Int -> Encoding -> ShowS)
-> (Encoding -> String) -> ([Encoding] -> ShowS) -> Show Encoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Encoding -> ShowS
showsPrec :: Int -> Encoding -> ShowS
$cshow :: Encoding -> String
show :: Encoding -> String
$cshowList :: [Encoding] -> ShowS
showList :: [Encoding] -> ShowS
Show)

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

data Name = NameNested NestedName
          | UnscopedName UnscopedName
          | UnscopedTemplateName Name TemplateArgs
          | LocalName Encoding Name (Maybe Discriminator)
          | StringLitName Encoding (Maybe Discriminator)
  deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show)

data UnscopedName = UnScName Bool UnqualifiedName -- Bool is "std::" prefix
                  | UnScSubst Substitution
  deriving (UnscopedName -> UnscopedName -> Bool
(UnscopedName -> UnscopedName -> Bool)
-> (UnscopedName -> UnscopedName -> Bool) -> Eq UnscopedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnscopedName -> UnscopedName -> Bool
== :: UnscopedName -> UnscopedName -> Bool
$c/= :: UnscopedName -> UnscopedName -> Bool
/= :: UnscopedName -> UnscopedName -> Bool
Eq, Int -> UnscopedName -> ShowS
[UnscopedName] -> ShowS
UnscopedName -> String
(Int -> UnscopedName -> ShowS)
-> (UnscopedName -> String)
-> ([UnscopedName] -> ShowS)
-> Show UnscopedName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnscopedName -> ShowS
showsPrec :: Int -> UnscopedName -> ShowS
$cshow :: UnscopedName -> String
show :: UnscopedName -> String
$cshowList :: [UnscopedName] -> ShowS
showList :: [UnscopedName] -> ShowS
Show)

data NestedName = NestedName Prefix UnqualifiedName
                  [CVQualifier] (Maybe RefQualifier)
                | NestedTemplateName TemplatePrefix TemplateArgs
                  [CVQualifier] (Maybe RefQualifier)
  deriving (NestedName -> NestedName -> Bool
(NestedName -> NestedName -> Bool)
-> (NestedName -> NestedName -> Bool) -> Eq NestedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NestedName -> NestedName -> Bool
== :: NestedName -> NestedName -> Bool
$c/= :: NestedName -> NestedName -> Bool
/= :: NestedName -> NestedName -> Bool
Eq, Int -> NestedName -> ShowS
[NestedName] -> ShowS
NestedName -> String
(Int -> NestedName -> ShowS)
-> (NestedName -> String)
-> ([NestedName] -> ShowS)
-> Show NestedName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NestedName -> ShowS
showsPrec :: Int -> NestedName -> ShowS
$cshow :: NestedName -> String
show :: NestedName -> String
$cshowList :: [NestedName] -> ShowS
showList :: [NestedName] -> ShowS
Show)

type FunctionEntity = Coord

-- The Discriminator is simply a non-negative number used to identify a
-- particular instance of a name.  It is the rather unusual case for C++ that
-- there may be several distinct functions that have the exact same demangled
-- representation.  This can also happen if multiple entities with the same name
-- in different scopes.  The Discriminator is used to identify which actual
-- function is being referenced, even though it's not possible to tell which one
-- based on the visible demangled name.
newtype Discriminator = Discriminator Natural
  deriving (Discriminator -> Discriminator -> Bool
(Discriminator -> Discriminator -> Bool)
-> (Discriminator -> Discriminator -> Bool) -> Eq Discriminator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Discriminator -> Discriminator -> Bool
== :: Discriminator -> Discriminator -> Bool
$c/= :: Discriminator -> Discriminator -> Bool
/= :: Discriminator -> Discriminator -> Bool
Eq, Int -> Discriminator -> ShowS
[Discriminator] -> ShowS
Discriminator -> String
(Int -> Discriminator -> ShowS)
-> (Discriminator -> String)
-> ([Discriminator] -> ShowS)
-> Show Discriminator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Discriminator -> ShowS
showsPrec :: Int -> Discriminator -> ShowS
$cshow :: Discriminator -> String
show :: Discriminator -> String
$cshowList :: [Discriminator] -> ShowS
showList :: [Discriminator] -> ShowS
Show)

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

type IsPartition = Bool

data UnqualifiedName = SourceName SourceName [ABI_Tag]
                     | OperatorName Operator [ABI_Tag]
                     | CtorDtorName CtorDtor
                     | StdSubst Substitution
                     | ModuleNamed [ModuleName] UnqualifiedName
                     | UnnamedTypeName (Maybe Natural) -- Nothing = first instance
                     --  | StructuredBinding ...
  deriving (UnqualifiedName -> UnqualifiedName -> Bool
(UnqualifiedName -> UnqualifiedName -> Bool)
-> (UnqualifiedName -> UnqualifiedName -> Bool)
-> Eq UnqualifiedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnqualifiedName -> UnqualifiedName -> Bool
== :: UnqualifiedName -> UnqualifiedName -> Bool
$c/= :: UnqualifiedName -> UnqualifiedName -> Bool
/= :: UnqualifiedName -> UnqualifiedName -> Bool
Eq, Int -> UnqualifiedName -> ShowS
[UnqualifiedName] -> ShowS
UnqualifiedName -> String
(Int -> UnqualifiedName -> ShowS)
-> (UnqualifiedName -> String)
-> ([UnqualifiedName] -> ShowS)
-> Show UnqualifiedName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnqualifiedName -> ShowS
showsPrec :: Int -> UnqualifiedName -> ShowS
$cshow :: UnqualifiedName -> String
show :: UnqualifiedName -> String
$cshowList :: [UnqualifiedName] -> ShowS
showList :: [UnqualifiedName] -> ShowS
Show)

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

data CtorDtor = CompleteCtor
              | BaseCtor
              | CompleteAllocatingCtor
              | CompleteInheritingCtor Type_
              | BaseInheritingCtor Type_
              | DeletingDtor
              | CompleteDtor
              | BaseDtor
  deriving (CtorDtor -> CtorDtor -> Bool
(CtorDtor -> CtorDtor -> Bool)
-> (CtorDtor -> CtorDtor -> Bool) -> Eq CtorDtor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CtorDtor -> CtorDtor -> Bool
== :: CtorDtor -> CtorDtor -> Bool
$c/= :: CtorDtor -> CtorDtor -> Bool
/= :: CtorDtor -> CtorDtor -> Bool
Eq, Int -> CtorDtor -> ShowS
[CtorDtor] -> ShowS
CtorDtor -> String
(Int -> CtorDtor -> ShowS)
-> (CtorDtor -> String) -> ([CtorDtor] -> ShowS) -> Show CtorDtor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CtorDtor -> ShowS
showsPrec :: Int -> CtorDtor -> ShowS
$cshow :: CtorDtor -> String
show :: CtorDtor -> String
$cshowList :: [CtorDtor] -> ShowS
showList :: [CtorDtor] -> ShowS
Show)

data Operator = OpNew
              | OpNewArr
              | OpDel
              | OpDelArr
              | OpCoAwait
              | OpPositive
              | OpNegative
              | OpAddress
              | OpDeReference
              | OpComplement
              | OpPlus
              | OpMinus
              | OpMultiply
              | OpDivide
              | OpRemainder
              | OpAnd
              | OpOr
              | OpXOR
              | OpAssign
              | OpAssignPlus
              | OpAssignMinus
              | OpAssignMul
              | OpAssignDiv
              | OpAssignRem
              | OpAssignAnd
              | OpAssignOr
              | OpAssignXOR
              | OpLeftShift
              | OpRightShift
              | OpAssignShL
              | OpAssignShR
              | OpEq
              | OpNotEq
              | OpLT
              | OpGT
              | OpLTE
              | OpGTE
              | OpSpan
              | OpNot
              | OpLogicalAnd
              | OpLogicalOr
              | OpPlusPlus
              | OpMinusMinus
              | OpComma
              | OpPointStar
              | OpPoint
              | OpCall
              | OpIndex
              | OpQuestion
              | OpSizeOfType
              | OpSizeOfExpr
              | OpAlignOfType
              | OpAlignOfExpr
              | OpCast Type_
              | OpString SourceName
              | OpVendor Natural SourceName
  deriving (Operator -> Operator -> Bool
(Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool) -> Eq Operator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
/= :: Operator -> Operator -> Bool
Eq, Int -> Operator -> ShowS
[Operator] -> ShowS
Operator -> String
(Int -> Operator -> ShowS)
-> (Operator -> String) -> ([Operator] -> ShowS) -> Show Operator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operator -> ShowS
showsPrec :: Int -> Operator -> ShowS
$cshow :: Operator -> String
show :: Operator -> String
$cshowList :: [Operator] -> ShowS
showList :: [Operator] -> ShowS
Show)


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

data SpecialName = VirtualTable Type_
                 | TemplateParameterObj TemplateArg
                 | VTT Type_
                 | TypeInfo Type_ -- struct
                 | TypeInfoName Type_
                 | Thunk CallOffset Encoding
                 | CtorVTable ()
  deriving (SpecialName -> SpecialName -> Bool
(SpecialName -> SpecialName -> Bool)
-> (SpecialName -> SpecialName -> Bool) -> Eq SpecialName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecialName -> SpecialName -> Bool
== :: SpecialName -> SpecialName -> Bool
$c/= :: SpecialName -> SpecialName -> Bool
/= :: SpecialName -> SpecialName -> Bool
Eq, Int -> SpecialName -> ShowS
[SpecialName] -> ShowS
SpecialName -> String
(Int -> SpecialName -> ShowS)
-> (SpecialName -> String)
-> ([SpecialName] -> ShowS)
-> Show SpecialName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecialName -> ShowS
showsPrec :: Int -> SpecialName -> ShowS
$cshow :: SpecialName -> String
show :: SpecialName -> String
$cshowList :: [SpecialName] -> ShowS
showList :: [SpecialName] -> ShowS
Show)

data CallOffset = VirtualOffset Int Int  -- base override, vcall offset
                | NonVirtualOffset Int   -- base override
  deriving (CallOffset -> CallOffset -> Bool
(CallOffset -> CallOffset -> Bool)
-> (CallOffset -> CallOffset -> Bool) -> Eq CallOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CallOffset -> CallOffset -> Bool
== :: CallOffset -> CallOffset -> Bool
$c/= :: CallOffset -> CallOffset -> Bool
/= :: CallOffset -> CallOffset -> Bool
Eq, Int -> CallOffset -> ShowS
[CallOffset] -> ShowS
CallOffset -> String
(Int -> CallOffset -> ShowS)
-> (CallOffset -> String)
-> ([CallOffset] -> ShowS)
-> Show CallOffset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CallOffset -> ShowS
showsPrec :: Int -> CallOffset -> ShowS
$cshow :: CallOffset -> String
show :: CallOffset -> String
$cshowList :: [CallOffset] -> ShowS
showList :: [CallOffset] -> ShowS
Show)

data Substitution' = SubsFirst
                   | Subs Natural  -- Note: converted from Base36 in mangled form
                   | SubsConst Substitution
  deriving Int -> Substitution' -> ShowS
[Substitution'] -> ShowS
Substitution' -> String
(Int -> Substitution' -> ShowS)
-> (Substitution' -> String)
-> ([Substitution'] -> ShowS)
-> Show Substitution'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Substitution' -> ShowS
showsPrec :: Int -> Substitution' -> ShowS
$cshow :: Substitution' -> String
show :: Substitution' -> String
$cshowList :: [Substitution'] -> ShowS
showList :: [Substitution'] -> ShowS
Show

data Substitution = SubStd  -- "std::", a prefix, needing subsequent name
                  | SubAlloc -- "std::allocator", a prefix, needs template arg
                  | SubBasicString -- "std::basic_string", needs template args
                  | SubStdType StdType
  deriving (Substitution -> Substitution -> Bool
(Substitution -> Substitution -> Bool)
-> (Substitution -> Substitution -> Bool) -> Eq Substitution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Substitution -> Substitution -> Bool
== :: Substitution -> Substitution -> Bool
$c/= :: Substitution -> Substitution -> Bool
/= :: Substitution -> Substitution -> Bool
Eq, Int -> Substitution -> ShowS
[Substitution] -> ShowS
Substitution -> String
(Int -> Substitution -> ShowS)
-> (Substitution -> String)
-> ([Substitution] -> ShowS)
-> Show Substitution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Substitution -> ShowS
showsPrec :: Int -> Substitution -> ShowS
$cshow :: Substitution -> String
show :: Substitution -> String
$cshowList :: [Substitution] -> ShowS
showList :: [Substitution] -> ShowS
Show)


data Type_ = BaseType BaseType
           | QualifiedType [ExtendedQualifier] [CVQualifier] Type_
           | ClassUnionStructEnum Name
           | ClassStruct Name
           | Union Name
           | Enum Name
           | Function [CVQualifier] (Maybe ExceptionSpec)
             Transaction Bool Type_ (NonEmpty Type_) (Maybe RefQualifier)
           | Template TemplateParam TemplateArgs
           | Pointer Type_
           | LValRef Type_
           | RValRef Type_
           | ComplexPair Type_
           | Imaginary Type_
           | Cpp11PackExpansion (NonEmpty Type_)
           | StdType StdType
           | ArrayType ArrayBound Type_
           | DeclType_ DeclType
           | PointerToMember Type_ Type_  -- class type, member type
  deriving (Type_ -> Type_ -> Bool
(Type_ -> Type_ -> Bool) -> (Type_ -> Type_ -> Bool) -> Eq Type_
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type_ -> Type_ -> Bool
== :: Type_ -> Type_ -> Bool
$c/= :: Type_ -> Type_ -> Bool
/= :: Type_ -> Type_ -> Bool
Eq, Int -> Type_ -> ShowS
[Type_] -> ShowS
Type_ -> String
(Int -> Type_ -> ShowS)
-> (Type_ -> String) -> ([Type_] -> ShowS) -> Show Type_
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type_ -> ShowS
showsPrec :: Int -> Type_ -> ShowS
$cshow :: Type_ -> String
show :: Type_ -> String
$cshowList :: [Type_] -> ShowS
showList :: [Type_] -> ShowS
Show)

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

data ExceptionSpec = NonThrowing
                   | ComputedThrow Expression
                   | Throwing (NonEmpty Type_)
  deriving (ExceptionSpec -> ExceptionSpec -> Bool
(ExceptionSpec -> ExceptionSpec -> Bool)
-> (ExceptionSpec -> ExceptionSpec -> Bool) -> Eq ExceptionSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExceptionSpec -> ExceptionSpec -> Bool
== :: ExceptionSpec -> ExceptionSpec -> Bool
$c/= :: ExceptionSpec -> ExceptionSpec -> Bool
/= :: ExceptionSpec -> ExceptionSpec -> Bool
Eq, Int -> ExceptionSpec -> ShowS
[ExceptionSpec] -> ShowS
ExceptionSpec -> String
(Int -> ExceptionSpec -> ShowS)
-> (ExceptionSpec -> String)
-> ([ExceptionSpec] -> ShowS)
-> Show ExceptionSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExceptionSpec -> ShowS
showsPrec :: Int -> ExceptionSpec -> ShowS
$cshow :: ExceptionSpec -> String
show :: ExceptionSpec -> String
$cshowList :: [ExceptionSpec] -> ShowS
showList :: [ExceptionSpec] -> ShowS
Show)

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

data BaseType = Void | Wchar_t | Bool_
              | Char_ | SChar | UChar
              | Short | UShort
              | Int_ | UInt
              | Long | ULong
              | LongLong | ULongLong
              | Int128 | UInt128
              | Float_ | Double_ | LongDouble80 | Float128
              | Ellipsis
              | IEE754rDecFloat64
              | IEE754rDecFloat128
              | IEE754rDecFloat32
              | IEE754rDecFloat16
              | FloatN Natural
              | FloatNx Natural
              | BFloat16
              | SBitInt Natural | UBitInt Natural
              | Char32 | Char16 | Char8
              | Auto | DeclTypeAuto
              | NullPtr
              | N1168FixedPointAccum
              | N1168FixedPointAccumSat
              | N1168FixedPointFract
              | N1168FixedPointFractSat
              | VendorExtendedType SourceName (Maybe TemplateArgs)
  deriving (BaseType -> BaseType -> Bool
(BaseType -> BaseType -> Bool)
-> (BaseType -> BaseType -> Bool) -> Eq BaseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BaseType -> BaseType -> Bool
== :: BaseType -> BaseType -> Bool
$c/= :: BaseType -> BaseType -> Bool
/= :: BaseType -> BaseType -> Bool
Eq, Int -> BaseType -> ShowS
[BaseType] -> ShowS
BaseType -> String
(Int -> BaseType -> ShowS)
-> (BaseType -> String) -> ([BaseType] -> ShowS) -> Show BaseType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BaseType -> ShowS
showsPrec :: Int -> BaseType -> ShowS
$cshow :: BaseType -> String
show :: BaseType -> String
$cshowList :: [BaseType] -> ShowS
showList :: [BaseType] -> ShowS
Show)

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

-- Qualifiers: there may be 0 or more (as expressed via an array) but there will
-- only be one of each, and they are usually expressed in the order shown here,
-- and printed on the right side of the output they qualify in the reverse order
-- shown here.
data CVQualifier = Restrict | Volatile | Const_
  deriving (CVQualifier -> CVQualifier -> Bool
(CVQualifier -> CVQualifier -> Bool)
-> (CVQualifier -> CVQualifier -> Bool) -> Eq CVQualifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CVQualifier -> CVQualifier -> Bool
== :: CVQualifier -> CVQualifier -> Bool
$c/= :: CVQualifier -> CVQualifier -> Bool
/= :: CVQualifier -> CVQualifier -> Bool
Eq, Int -> CVQualifier -> ShowS
[CVQualifier] -> ShowS
CVQualifier -> String
(Int -> CVQualifier -> ShowS)
-> (CVQualifier -> String)
-> ([CVQualifier] -> ShowS)
-> Show CVQualifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CVQualifier -> ShowS
showsPrec :: Int -> CVQualifier -> ShowS
$cshow :: CVQualifier -> String
show :: CVQualifier -> String
$cshowList :: [CVQualifier] -> ShowS
showList :: [CVQualifier] -> ShowS
Show)
data RefQualifier = Ref | RefRef
  deriving (RefQualifier -> RefQualifier -> Bool
(RefQualifier -> RefQualifier -> Bool)
-> (RefQualifier -> RefQualifier -> Bool) -> Eq RefQualifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RefQualifier -> RefQualifier -> Bool
== :: RefQualifier -> RefQualifier -> Bool
$c/= :: RefQualifier -> RefQualifier -> Bool
/= :: RefQualifier -> RefQualifier -> Bool
Eq, Int -> RefQualifier -> ShowS
[RefQualifier] -> ShowS
RefQualifier -> String
(Int -> RefQualifier -> ShowS)
-> (RefQualifier -> String)
-> ([RefQualifier] -> ShowS)
-> Show RefQualifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RefQualifier -> ShowS
showsPrec :: Int -> RefQualifier -> ShowS
$cshow :: RefQualifier -> String
show :: RefQualifier -> String
$cshowList :: [RefQualifier] -> ShowS
showList :: [RefQualifier] -> ShowS
Show)
type ExtendedQualifier = () -- XXX TBD

data Prefix = PrefixTemplateParam TemplateParam PrefixR
            | PrefixDeclType DeclType PrefixR
            | PrefixClosure ClosurePrefix -- ??
            | Prefix PrefixR
  deriving (Prefix -> Prefix -> Bool
(Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool) -> Eq Prefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prefix -> Prefix -> Bool
== :: Prefix -> Prefix -> Bool
$c/= :: Prefix -> Prefix -> Bool
/= :: Prefix -> Prefix -> Bool
Eq, Int -> Prefix -> ShowS
[Prefix] -> ShowS
Prefix -> String
(Int -> Prefix -> ShowS)
-> (Prefix -> String) -> ([Prefix] -> ShowS) -> Show Prefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prefix -> ShowS
showsPrec :: Int -> Prefix -> ShowS
$cshow :: Prefix -> String
show :: Prefix -> String
$cshowList :: [Prefix] -> ShowS
showList :: [Prefix] -> ShowS
Show)

data PrefixR = PrefixUQName UnqualifiedName PrefixR
             | PrefixTemplateArgs TemplateArgs PrefixR
             | PrefixEnd
  deriving (PrefixR -> PrefixR -> Bool
(PrefixR -> PrefixR -> Bool)
-> (PrefixR -> PrefixR -> Bool) -> Eq PrefixR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrefixR -> PrefixR -> Bool
== :: PrefixR -> PrefixR -> Bool
$c/= :: PrefixR -> PrefixR -> Bool
/= :: PrefixR -> PrefixR -> Bool
Eq, Int -> PrefixR -> ShowS
[PrefixR] -> ShowS
PrefixR -> String
(Int -> PrefixR -> ShowS)
-> (PrefixR -> String) -> ([PrefixR] -> ShowS) -> Show PrefixR
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrefixR -> ShowS
showsPrec :: Int -> PrefixR -> ShowS
$cshow :: PrefixR -> String
show :: PrefixR -> String
$cshowList :: [PrefixR] -> ShowS
showList :: [PrefixR] -> ShowS
Show)

pattern EmptyPrefix :: Prefix
pattern $mEmptyPrefix :: forall {r}. Prefix -> ((# #) -> r) -> ((# #) -> r) -> r
$bEmptyPrefix :: Prefix
EmptyPrefix = Prefix PrefixEnd


data TemplatePrefix = GlobalTemplate (NonEmpty UnqualifiedName)
                    | NestedTemplate Prefix (NonEmpty UnqualifiedName)
                    | TemplateTemplateParam TemplateParam
  deriving (TemplatePrefix -> TemplatePrefix -> Bool
(TemplatePrefix -> TemplatePrefix -> Bool)
-> (TemplatePrefix -> TemplatePrefix -> Bool) -> Eq TemplatePrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TemplatePrefix -> TemplatePrefix -> Bool
== :: TemplatePrefix -> TemplatePrefix -> Bool
$c/= :: TemplatePrefix -> TemplatePrefix -> Bool
/= :: TemplatePrefix -> TemplatePrefix -> Bool
Eq, Int -> TemplatePrefix -> ShowS
[TemplatePrefix] -> ShowS
TemplatePrefix -> String
(Int -> TemplatePrefix -> ShowS)
-> (TemplatePrefix -> String)
-> ([TemplatePrefix] -> ShowS)
-> Show TemplatePrefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TemplatePrefix -> ShowS
showsPrec :: Int -> TemplatePrefix -> ShowS
$cshow :: TemplatePrefix -> String
show :: TemplatePrefix -> String
$cshowList :: [TemplatePrefix] -> ShowS
showList :: [TemplatePrefix] -> ShowS
Show)

type TemplateName = Name

type TemplateArgs = NonEmpty TemplateArg

data TemplateArg = TArgType Type_
                 | TArgExpr Expression
                 | TArgSimpleExpr ExprPrimary
                 | TArgPack [TemplateArg]
  deriving (TemplateArg -> TemplateArg -> Bool
(TemplateArg -> TemplateArg -> Bool)
-> (TemplateArg -> TemplateArg -> Bool) -> Eq TemplateArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TemplateArg -> TemplateArg -> Bool
== :: TemplateArg -> TemplateArg -> Bool
$c/= :: TemplateArg -> TemplateArg -> Bool
/= :: TemplateArg -> TemplateArg -> Bool
Eq, Int -> TemplateArg -> ShowS
[TemplateArg] -> ShowS
TemplateArg -> String
(Int -> TemplateArg -> ShowS)
-> (TemplateArg -> String)
-> ([TemplateArg] -> ShowS)
-> Show TemplateArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TemplateArg -> ShowS
showsPrec :: Int -> TemplateArg -> ShowS
$cshow :: TemplateArg -> String
show :: TemplateArg -> String
$cshowList :: [TemplateArg] -> ShowS
showList :: [TemplateArg] -> ShowS
Show)

type TemplateParam = TemplateArg

data Expression = ExprUnary Operator Expression
                | ExprBinary Operator Expression Expression
                | ExprTrinary Operator Expression Expression Expression
                | ExprPfxPlus Expression
                | ExprPfxMinus Expression
                | ExprCall (NonEmpty Expression) -- call target :| [args]
                | ExprConvert1 Type_ Expression
                | ExprConvertSome Type_ (NonEmpty Expression)
                | ExprConvertInit Type_ [BracedExpression]
                | ExprBracedInit [BracedExpression]
                | ExprNew GlobalScope [Expression] Type_
                | ExprNewInit GlobalScope [Expression] Type_ InitializerExpr
                | ExprNewArray GlobalScope [Expression] Type_
                | ExprNewInitArray GlobalScope [Expression] Type_ InitializerExpr
                | ExprDel GlobalScope Expression
                | ExprDelArray GlobalScope Expression
                | ExprDynamicCast Type_ Expression
                | ExprStaticCast Type_ Expression
                | ExprConstCast Type_ Expression
                | ExprReinterpretCast Type_ Expression
                | ExprTypeIdType Type_
                | ExprTypeId Expression
                | ExprSizeOfType Type_
                | ExprSizeOf Expression
                | ExprAlignOfType Type_
                | ExprAlignOf Expression
                | ExprNoException Expression
                | ExprTemplateParam TemplateParam
                | ExprFunctionParam FunctionParam
                | ExprField Expression UnresolvedName
                | ExprFieldPtr Expression UnresolvedName
                | ExprFieldExpr Expression Expression
                | ExprSizeOfTmplParamPack TemplateParam
                | ExprSizeOfFuncParamPack FunctionParam
                | ExprSizeOfCapturedTmplParamPack [TemplateArg]
                | ExprPack Expression
                | ExprUnaryLeftFold Operator Expression
                | ExprUnaryRightFold Operator Expression
                | ExprBinaryLeftFold Operator Expression Expression
                | ExprBinaryRightFold Operator Expression Expression
                | ExprThrow Expression
                | ExprReThrow
                | ExprVendorExtended SourceName [TemplateArg]
                | ExprUnresolvedName UnresolvedName
                | ExprPrim ExprPrimary
  deriving (Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
/= :: Expression -> Expression -> Bool
Eq, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expression -> ShowS
showsPrec :: Int -> Expression -> ShowS
$cshow :: Expression -> String
show :: Expression -> String
$cshowList :: [Expression] -> ShowS
showList :: [Expression] -> ShowS
Show)

type GlobalScope = Bool

data ExprPrimary = IntLit Type_ Int
                 | FloatLit Type_ Float
                 | DirectLit Type_  -- String or NullPtr
                 | NullPtrTemplateArg Type_
                 | ComplexFloatLit Type_ Float Float
                 | ExternalNameLit Encoding
  deriving (ExprPrimary -> ExprPrimary -> Bool
(ExprPrimary -> ExprPrimary -> Bool)
-> (ExprPrimary -> ExprPrimary -> Bool) -> Eq ExprPrimary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExprPrimary -> ExprPrimary -> Bool
== :: ExprPrimary -> ExprPrimary -> Bool
$c/= :: ExprPrimary -> ExprPrimary -> Bool
/= :: ExprPrimary -> ExprPrimary -> Bool
Eq, Int -> ExprPrimary -> ShowS
[ExprPrimary] -> ShowS
ExprPrimary -> String
(Int -> ExprPrimary -> ShowS)
-> (ExprPrimary -> String)
-> ([ExprPrimary] -> ShowS)
-> Show ExprPrimary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExprPrimary -> ShowS
showsPrec :: Int -> ExprPrimary -> ShowS
$cshow :: ExprPrimary -> String
show :: ExprPrimary -> String
$cshowList :: [ExprPrimary] -> ShowS
showList :: [ExprPrimary] -> ShowS
Show)

data BracedExpression = BracedExpr Expression
                      | BracedFieldExpr SourceName BracedExpression -- .name = expr
                      | BracedIndexExpr Expression BracedExpression -- [idx] = expr
                      | BracedRangedExpr Expression Expression BracedExpression
                        -- [expr ... expr] = expr
  deriving (BracedExpression -> BracedExpression -> Bool
(BracedExpression -> BracedExpression -> Bool)
-> (BracedExpression -> BracedExpression -> Bool)
-> Eq BracedExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BracedExpression -> BracedExpression -> Bool
== :: BracedExpression -> BracedExpression -> Bool
$c/= :: BracedExpression -> BracedExpression -> Bool
/= :: BracedExpression -> BracedExpression -> Bool
Eq, Int -> BracedExpression -> ShowS
[BracedExpression] -> ShowS
BracedExpression -> String
(Int -> BracedExpression -> ShowS)
-> (BracedExpression -> String)
-> ([BracedExpression] -> ShowS)
-> Show BracedExpression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BracedExpression -> ShowS
showsPrec :: Int -> BracedExpression -> ShowS
$cshow :: BracedExpression -> String
show :: BracedExpression -> String
$cshowList :: [BracedExpression] -> ShowS
showList :: [BracedExpression] -> ShowS
Show)

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

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

data UnresolvedName = URN_Base GlobalScope BaseUnresolvedName
                    | URNScopedRef UnresolvedType BaseUnresolvedName
                    | URNSubScopedRef UnresolvedType
                      UnresolvedQualifierLevels BaseUnresolvedName
                    | URNQualRef GlobalScope
                      UnresolvedQualifierLevels BaseUnresolvedName
  deriving (UnresolvedName -> UnresolvedName -> Bool
(UnresolvedName -> UnresolvedName -> Bool)
-> (UnresolvedName -> UnresolvedName -> Bool) -> Eq UnresolvedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnresolvedName -> UnresolvedName -> Bool
== :: UnresolvedName -> UnresolvedName -> Bool
$c/= :: UnresolvedName -> UnresolvedName -> Bool
/= :: UnresolvedName -> UnresolvedName -> Bool
Eq, Int -> UnresolvedName -> ShowS
[UnresolvedName] -> ShowS
UnresolvedName -> String
(Int -> UnresolvedName -> ShowS)
-> (UnresolvedName -> String)
-> ([UnresolvedName] -> ShowS)
-> Show UnresolvedName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnresolvedName -> ShowS
showsPrec :: Int -> UnresolvedName -> ShowS
$cshow :: UnresolvedName -> String
show :: UnresolvedName -> String
$cshowList :: [UnresolvedName] -> ShowS
showList :: [UnresolvedName] -> ShowS
Show)

type UnresolvedQualifierLevels = NonEmpty UnresolvedQualifierLevel

data BaseUnresolvedName = BUName SourceName (Maybe TemplateArgs)
                        | BUOnOperatorT Operator TemplateArgs
                        | BUOnOperator Operator
                        | BUDestructorUnresolvedType UnresolvedType
                        | BUDestructorSimpleId SourceName (Maybe TemplateArgs)
  deriving (BaseUnresolvedName -> BaseUnresolvedName -> Bool
(BaseUnresolvedName -> BaseUnresolvedName -> Bool)
-> (BaseUnresolvedName -> BaseUnresolvedName -> Bool)
-> Eq BaseUnresolvedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BaseUnresolvedName -> BaseUnresolvedName -> Bool
== :: BaseUnresolvedName -> BaseUnresolvedName -> Bool
$c/= :: BaseUnresolvedName -> BaseUnresolvedName -> Bool
/= :: BaseUnresolvedName -> BaseUnresolvedName -> Bool
Eq, Int -> BaseUnresolvedName -> ShowS
[BaseUnresolvedName] -> ShowS
BaseUnresolvedName -> String
(Int -> BaseUnresolvedName -> ShowS)
-> (BaseUnresolvedName -> String)
-> ([BaseUnresolvedName] -> ShowS)
-> Show BaseUnresolvedName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BaseUnresolvedName -> ShowS
showsPrec :: Int -> BaseUnresolvedName -> ShowS
$cshow :: BaseUnresolvedName -> String
show :: BaseUnresolvedName -> String
$cshowList :: [BaseUnresolvedName] -> ShowS
showList :: [BaseUnresolvedName] -> ShowS
Show)


data UnresolvedType = URTTemplate TemplateParam (Maybe TemplateArgs)
                    | URTDeclType DeclType
                    | URTSubstPrefix Prefix -- never parsed: subst insertion
  deriving (UnresolvedType -> UnresolvedType -> Bool
(UnresolvedType -> UnresolvedType -> Bool)
-> (UnresolvedType -> UnresolvedType -> Bool) -> Eq UnresolvedType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnresolvedType -> UnresolvedType -> Bool
== :: UnresolvedType -> UnresolvedType -> Bool
$c/= :: UnresolvedType -> UnresolvedType -> Bool
/= :: UnresolvedType -> UnresolvedType -> Bool
Eq, Int -> UnresolvedType -> ShowS
[UnresolvedType] -> ShowS
UnresolvedType -> String
(Int -> UnresolvedType -> ShowS)
-> (UnresolvedType -> String)
-> ([UnresolvedType] -> ShowS)
-> Show UnresolvedType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnresolvedType -> ShowS
showsPrec :: Int -> UnresolvedType -> ShowS
$cshow :: UnresolvedType -> String
show :: UnresolvedType -> String
$cshowList :: [UnresolvedType] -> ShowS
showList :: [UnresolvedType] -> ShowS
Show)


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

type ClosurePrefix = () -- XXX TBD


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


-- | Table of builtin types as the internal BaseType representation, followed by
-- a tuple of strings.  The first string is the reference to this type in a
-- mangled name.  The second string is the C/C++ type name to be used when
-- writing a value cast.  The third string, if specified, is a C/C++ suffix that
-- can be written after literal values to indicate the type instead (for example,
-- emit `10ul` instead of `(unsigned long)10`).

builtinTypeTable :: [ (BaseType, (Text, Text, Maybe Text)) ]
builtinTypeTable :: [(BaseType, (Text, Text, Maybe Text))]
builtinTypeTable =
  [ (BaseType
Void, (Text
"v", Text
"void", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Wchar_t, (Text
"w", Text
"wchar_t", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Bool_, (Text
"b", Text
"bool", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Char_, (Text
"c", Text
"char", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
SChar, (Text
"a", Text
"signed char", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
UChar, (Text
"h", Text
"unsigned char", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Short, (Text
"s", Text
"short", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
UShort, (Text
"t", Text
"unsigned short", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Int_, (Text
"i", Text
"int", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""))
  , (BaseType
UInt, (Text
"j", Text
"unsigned int", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"u"))
  , (BaseType
Long, (Text
"l", Text
"long", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"l"))
  , (BaseType
ULong, (Text
"m", Text
"unsigned long", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ul"))
  , (BaseType
LongLong, (Text
"x", Text
"long long", Maybe Text
forall a. Maybe a
Nothing)) -- __int64
  , (BaseType
ULongLong, (Text
"y", Text
"unsigned long long", Maybe Text
forall a. Maybe a
Nothing)) -- __int64
  , (BaseType
Int128, (Text
"n", Text
"__int128", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
UInt128, (Text
"o", Text
"unsigned __int128", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Float_, (Text
"f", Text
"float", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Double_, (Text
"d", Text
"double", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
LongDouble80, (Text
"e", Text
"long double", Maybe Text
forall a. Maybe a
Nothing)) -- __float80
  , (BaseType
Float128, (Text
"g", Text
"__float128", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Ellipsis, (Text
"z", Text
"...", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
IEE754rDecFloat64, (Text
"Dd", Text
"__ieeefloat64", Maybe Text
forall a. Maybe a
Nothing)) -- ??
  , (BaseType
IEE754rDecFloat128, (Text
"De", Text
"__ieeefloat128", Maybe Text
forall a. Maybe a
Nothing)) -- ??
  , (BaseType
IEE754rDecFloat32, (Text
"Df", Text
"__ieeefloat32", Maybe Text
forall a. Maybe a
Nothing)) -- ??
  , (BaseType
IEE754rDecFloat16, (Text
"Dh", Text
"__ieeefloat16", Maybe Text
forall a. Maybe a
Nothing)) -- ??
  , (BaseType
BFloat16, (Text
"DF16b", Text
"std::bfloat16_t", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Char32, (Text
"Di", Text
"char32_t", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Char16, (Text
"Ds", Text
"char16_t", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Char8, (Text
"Du", Text
"char8_t", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
Auto, (Text
"Da", Text
"auto", Maybe Text
forall a. Maybe a
Nothing))
  , (BaseType
DeclTypeAuto, (Text
"Dc", Text
"decltype(auto)", Maybe Text
forall a. Maybe a
Nothing)) -- ??
  , (BaseType
NullPtr, (Text
"Dn", Text
"std::nullptr_t", Maybe Text
forall a. Maybe a
Nothing)) -- decltype(nullptr)
  , (BaseType
N1168FixedPointAccum, (Text
"DA", Text
"T _Accum", Maybe Text
forall a. Maybe a
Nothing)) -- ??
  , (BaseType
N1168FixedPointAccumSat, (Text
"DS DA", Text
"_Sat T _Accum", Maybe Text
forall a. Maybe a
Nothing)) -- ??
  , (BaseType
N1168FixedPointFract, (Text
"DR", Text
"T _Fract", Maybe Text
forall a. Maybe a
Nothing)) -- ??
  , (BaseType
N1168FixedPointFractSat, (Text
"DS DR", Text
"_Sat T _Fract", Maybe Text
forall a. Maybe a
Nothing)) -- ??
  ]

data Arity = Unary | Binary | Trinary | NoArity
  deriving Arity -> Arity -> Bool
(Arity -> Arity -> Bool) -> (Arity -> Arity -> Bool) -> Eq Arity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Arity -> Arity -> Bool
== :: Arity -> Arity -> Bool
$c/= :: Arity -> Arity -> Bool
/= :: Arity -> Arity -> Bool
Eq

opTable :: [ (Operator, (Arity, (Text, Text))) ]
opTable :: [(Operator, (Arity, (Text, Text)))]
opTable =
  [ (Operator
OpNew,         (Arity
NoArity, (Text
"nw", Text
" new")))
  , (Operator
OpNewArr,      (Arity
NoArity, (Text
"na", Text
" new[]")))
  , (Operator
OpDel,         (Arity
NoArity, (Text
"dl", Text
" delete")))
  , (Operator
OpDelArr,      (Arity
NoArity, (Text
"da", Text
" delete[]")))
  , (Operator
OpCoAwait,     (Arity
NoArity, (Text
"aw", Text
" co_await")))
  , (Operator
OpPositive,    (Arity
Unary, (Text
"ps", Text
"+")))
  , (Operator
OpNegative,    (Arity
Unary, (Text
"ng", Text
"-")))
  , (Operator
OpAddress,     (Arity
Unary, (Text
"ad", Text
"&")))
  , (Operator
OpDeReference, (Arity
Unary, (Text
"de", Text
"*")))
  , (Operator
OpComplement,  (Arity
Unary, (Text
"co", Text
"~")))
  , (Operator
OpPlus,        (Arity
Binary, (Text
"pl", Text
"+")))
  , (Operator
OpMinus,       (Arity
Binary, (Text
"mi", Text
"-")))
  , (Operator
OpMultiply,    (Arity
Binary, (Text
"ml", Text
"*")))
  , (Operator
OpDivide,      (Arity
Binary, (Text
"dv", Text
"/")))
  , (Operator
OpRemainder,   (Arity
Binary, (Text
"rm", Text
"%")))
  , (Operator
OpAnd,         (Arity
Binary, (Text
"an", Text
"&")))
  , (Operator
OpOr,          (Arity
Binary, (Text
"or", Text
"|")))
  , (Operator
OpXOR,         (Arity
Binary, (Text
"eo", Text
"^")))
  , (Operator
OpAssign,      (Arity
Binary, (Text
"aS", Text
"=")))
  , (Operator
OpAssignPlus,  (Arity
Binary, (Text
"pL", Text
"+=")))
  , (Operator
OpAssignMinus, (Arity
Binary, (Text
"mI", Text
"-=")))
  , (Operator
OpAssignMul,   (Arity
Binary, (Text
"mL", Text
"*=")))
  , (Operator
OpAssignDiv,   (Arity
Binary, (Text
"dV", Text
"/=")))
  , (Operator
OpAssignRem,   (Arity
Binary, (Text
"rM", Text
"%=")))
  , (Operator
OpAssignAnd,   (Arity
Binary, (Text
"aN", Text
"&=")))
  , (Operator
OpAssignOr,    (Arity
Binary, (Text
"oR", Text
"|=")))
  , (Operator
OpAssignXOR,   (Arity
Binary, (Text
"eO", Text
"^=")))
  , (Operator
OpLeftShift,   (Arity
Binary, (Text
"ls", Text
"<<")))
  , (Operator
OpRightShift,  (Arity
Binary, (Text
"rs", Text
">>")))
  , (Operator
OpAssignShL,   (Arity
Binary, (Text
"lS", Text
"<<=")))
  , (Operator
OpAssignShR,   (Arity
Binary, (Text
"rS", Text
">>=")))
  , (Operator
OpEq,          (Arity
Binary, (Text
"eq", Text
"==")))
  , (Operator
OpNotEq,       (Arity
Binary, (Text
"ne", Text
"!=")))
  , (Operator
OpLT,          (Arity
Binary, (Text
"lt", Text
"<")))
  , (Operator
OpGT,          (Arity
Binary, (Text
"gt", Text
">")))
  , (Operator
OpLTE,         (Arity
Binary, (Text
"le", Text
"<=")))
  , (Operator
OpGTE,         (Arity
Binary, (Text
"ge", Text
">=")))
  , (Operator
OpSpan,        (Arity
Binary, (Text
"ss", Text
"<=>")))
  , (Operator
OpNot,         (Arity
Unary, (Text
"nt", Text
"!")))
  , (Operator
OpLogicalAnd,  (Arity
Binary, (Text
"aa", Text
"&&")))
  , (Operator
OpLogicalOr,   (Arity
Binary, (Text
"oo", Text
"||")))
  , (Operator
OpPlusPlus,    (Arity
Unary, (Text
"pp", Text
"++")))
  , (Operator
OpMinusMinus,  (Arity
Unary, (Text
"mm", Text
"--")))
  , (Operator
OpComma,       (Arity
Binary, (Text
"cm", Text
",")))
  , (Operator
OpPointStar,   (Arity
Binary, (Text
"pm", Text
"->*")))
  , (Operator
OpPoint,       (Arity
Binary, (Text
"pt", Text
"->")))
  , (Operator
OpCall,        (Arity
NoArity, (Text
"cl", Text
"()")))
  , (Operator
OpIndex,       (Arity
NoArity, (Text
"ix", Text
"[]")))
  , (Operator
OpQuestion,    (Arity
Trinary, (Text
"qu", Text
"?")))
  , (Operator
OpSizeOfType,  (Arity
Unary, (Text
"st", Text
" sizeof")))
  , (Operator
OpAlignOfType, (Arity
Unary, (Text
"at", Text
" alignof")))
  , (Operator
OpSizeOfExpr,  (Arity
Unary, (Text
"sz", Text
" sizeof")))
  , (Operator
OpAlignOfExpr, (Arity
Unary, (Text
"az", Text
" alignof")))
  ]


----------------------------------------------------------------------
-- Core data structure utilized by Substitution but which must be defined for
-- other users.

data SubsCandidate = SC_Type Type_
                   | SC_UQName Bool UnqualifiedName
                     -- ^ Bool is True for std:: namespace prefix
                   | SC_Prefix Prefix
                   | SC_TemplatePrefix TemplatePrefix
                   | SC_UnresolvedType UnresolvedType
  deriving (SubsCandidate -> SubsCandidate -> Bool
(SubsCandidate -> SubsCandidate -> Bool)
-> (SubsCandidate -> SubsCandidate -> Bool) -> Eq SubsCandidate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubsCandidate -> SubsCandidate -> Bool
== :: SubsCandidate -> SubsCandidate -> Bool
$c/= :: SubsCandidate -> SubsCandidate -> Bool
/= :: SubsCandidate -> SubsCandidate -> Bool
Eq, Int -> SubsCandidate -> ShowS
[SubsCandidate] -> ShowS
SubsCandidate -> String
(Int -> SubsCandidate -> ShowS)
-> (SubsCandidate -> String)
-> ([SubsCandidate] -> ShowS)
-> Show SubsCandidate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubsCandidate -> ShowS
showsPrec :: Int -> SubsCandidate -> ShowS
$cshow :: SubsCandidate -> String
show :: SubsCandidate -> String
$cshowList :: [SubsCandidate] -> ShowS
showList :: [SubsCandidate] -> ShowS
Show)