{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-- OPTIONS_GHC -ddump-splices #-}

module Demangler.PPrint () where

import           Data.Char
import           Data.List.NonEmpty ( NonEmpty((:|)) )
import qualified Data.List.NonEmpty as NEL
import           Data.Text ( Text )
import qualified Data.Text as T
import           Text.Sayable

import           Demangler.Context
import           Demangler.Engine
import           Demangler.Structure


#ifdef MIN_VERSION_panic
import           Panic

-- Debug function to cause a Panic with -fdebug builds, or return a placeholder
-- in non-debug mode.  This is usually used for unfinished portions of the
-- output, to provide a useful panic when in development mode but to avoid
-- crashing in normal mode.  Note that the demangling process uses a similar
-- function to fail the parse; here, the parse has completed and we are simply
-- generating output, so we don't have the option to "revert" to the original.
-- Instead, emitting invalid output (without failing) is the most useful
-- operation, since the valid form of that output is not currently
-- known/implemented.
cannotSay :: PanicComponent a => a -> String -> [String] -> b
cannotSay = panic
#else
cannotSay :: a -> String -> [String] -> Saying saytag
cannotSay :: forall a (saytag :: Symbol).
a -> String -> [String] -> Saying saytag
cannotSay a
_ String
_ [String]
rsn = Text -> Text
t'Text
"OUTFMT?:{ " forall (tag :: Symbol) m e (t :: * -> *).
(Sayable tag m, Sayable tag e, Foldable t) =>
m -> t e -> Saying tag
&* [String]
rsn forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Char
'}'
#endif


data PrefixUQN = PUC Prefix UnqualifiedName
data PrefixCDtor = PCDC Prefix CtorDtor

$(return [])

ctxLst :: forall saytag t a .
          Sayable saytag (WithContext a)
       => Functor t
       => Foldable t
       => t a -> Context -> Saying saytag
ctxLst :: forall (saytag :: Symbol) (t :: * -> *) a.
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Saying saytag
ctxLst t a
l Context
c = Text -> Text
t'Text
"" forall (tag :: Symbol) m e (t :: * -> *).
(Sayable tag m, Sayable tag e, Foldable t) =>
m -> t e -> Saying tag
&+* forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx t a
l Context
c

ctxLst' :: Sayable saytag (WithContext a)
        => Functor t
        => Foldable t
        => t a -> Context -> Text -> Saying saytag
ctxLst' :: forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' t a
l Context
c Text
sep = Text
sep forall (tag :: Symbol) m e (t :: * -> *).
(Sayable tag m, Sayable tag e, Foldable t) =>
m -> t e -> Saying tag
&:* forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx t a
l Context
c

wCtx :: Functor t => t a -> Context -> t (WithContext a)
wCtx :: forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx t a
a Context
c = (\a
b -> forall a. a -> Context -> WithContext a
WC a
b Context
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a
a


----------------------------------------------------------------------
-- Sayable instances for printing demangled results

instance {-# OVERLAPPING #-}
  ( Sayable "diagnostic" (WithContext Encoding)
  ) => Sayable "diagnostic" Result where
  sayable :: Result -> Saying "diagnostic"
sayable = \case
    (Original Coord
i, Context
c) -> Context -> Coord -> Text
contextStr Context
c Coord
i forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text -> Text
t'Text
"{orig}"
    (Encoded Encoding
e, Context
c) -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @"diagnostic" forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Encoding
e Context
c
    (VendorExtended Encoding
d Coord
i, Context
c) ->
      let (Text
s1,Text
s2) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isAlphaNum forall a b. (a -> b) -> a -> b
$ Context -> Coord -> Text
contextStr Context
c Coord
i
      in forall a. a -> Context -> WithContext a
WC Encoding
d Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text -> Text
t'Text
"[clone" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text
s1 forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
']' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text
s2

instance {-# OVERLAPPABLE #-}
  ( Sayable saytag (WithContext Encoding)
  ) => Sayable saytag Result where
  sayable :: Result -> Saying saytag
sayable = \case
    (Original Coord
i, Context
c) -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Context -> Coord -> Text
contextStr Context
c Coord
i
    (Encoded Encoding
e, Context
c) -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Encoding
e Context
c
    (VendorExtended Encoding
d Coord
i, Context
c) ->
      let (Text
s1,Text
s2) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isAlphaNum forall a b. (a -> b) -> a -> b
$ Context -> Coord -> Text
contextStr Context
c Coord
i
      in forall a. a -> Context -> WithContext a
WC Encoding
d Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text -> Text
t'Text
"[clone" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Char
'.' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text
s1 forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
']' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text
s2

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''Encoding
  ) => Sayable saytag (WithContext Encoding) where
  sayable :: WithContext Encoding -> Saying saytag
sayable (WC Encoding
n Context
c) =
    case Encoding
n of
      -- Note: if the function has only a single void argument, print "()"
      -- instead of "(void)"; these are semantically the same, but demangling
      -- emits the former.
      --
      -- Another tricky part is that the FunctionName may contain qualifiers
      -- (esp. "const") but for a function these must be placed at the end,
      -- following the arguments.
      EncFunc FunctionName
f Maybe Type_
rty (BaseType BaseType
Void :| []) -> forall (saytag :: Symbol).
Sayable saytag (WithContext Type_) =>
Context -> FunctionName -> Maybe Type_ -> [Type_] -> Saying saytag
sayFunction Context
c FunctionName
f Maybe Type_
rty []
      EncFunc FunctionName
f Maybe Type_
rty NonEmpty Type_
t -> forall (saytag :: Symbol).
Sayable saytag (WithContext Type_) =>
Context -> FunctionName -> Maybe Type_ -> [Type_] -> Saying saytag
sayFunction Context
c FunctionName
f Maybe Type_
rty forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Type_
t
      -- n.b. static functions don't have any visible difference in demangled
      -- form.
      EncStaticFunc FunctionName
f Maybe Type_
rty (BaseType BaseType
Void :| []) -> forall (saytag :: Symbol).
Sayable saytag (WithContext Type_) =>
Context -> FunctionName -> Maybe Type_ -> [Type_] -> Saying saytag
sayFunction Context
c FunctionName
f Maybe Type_
rty []
      EncStaticFunc FunctionName
f Maybe Type_
rty NonEmpty Type_
t -> forall (saytag :: Symbol).
Sayable saytag (WithContext Type_) =>
Context -> FunctionName -> Maybe Type_ -> [Type_] -> Saying saytag
sayFunction Context
c FunctionName
f Maybe Type_
rty forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Type_
t
      EncConstStructData UnqualifiedName
nm -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC UnqualifiedName
nm Context
c
      EncData Name
nm -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Name
nm Context
c
      EncSpecial SpecialName
sn -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC SpecialName
sn Context
c

sayFunction :: Sayable saytag (WithContext Type_)
            => Context -> FunctionName -> Maybe Type_ -> [Type_] -> Saying saytag
sayFunction :: forall (saytag :: Symbol).
Sayable saytag (WithContext Type_) =>
Context -> FunctionName -> Maybe Type_ -> [Type_] -> Saying saytag
sayFunction Context
c FunctionName
fn Maybe Type_
mbRet [Type_]
args =
  let (Name
nm,[CVQualifier]
q) = FunctionName -> (Name, [CVQualifier])
cleanFunctionName FunctionName
fn
      part1 :: Saying saytag
part1 = case Maybe Type_
mbRet of
                Maybe Type_
Nothing -> forall a. a -> Context -> WithContext a
WC Name
nm Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
""
                Just Type_
rty -> forall a. a -> Context -> WithContext a
WC Type_
rty Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Name
nm Context
c
      part2 :: Saying saytag
part2 = Saying saytag
part1 forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'(' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall (saytag :: Symbol) (t :: * -> *) a.
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Saying saytag
ctxLst [Type_]
args Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')'
  in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CVQualifier]
q then Saying saytag
part2 else Saying saytag
part2 forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [CVQualifier]
q Context
c Text
" "

instance Sayable saytag (WithContext a)
  => Sayable saytag (NonEmpty (WithContext a)) where
  sayable :: NonEmpty (WithContext a) -> Saying saytag
sayable NonEmpty (WithContext a)
l = Text -> Text
t'Text
"" forall (tag :: Symbol) m e (t :: * -> *).
(Sayable tag m, Sayable tag e, Foldable t) =>
m -> t e -> Saying tag
&+* NonEmpty (WithContext a)
l

instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext a)
  => Sayable saytag (WithContext (NonEmpty a)) where
  sayable :: WithContext (NonEmpty a) -> Saying saytag
sayable (WC NonEmpty a
l Context
c) = forall (saytag :: Symbol) (t :: * -> *) a.
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Saying saytag
ctxLst NonEmpty a
l Context
c

cleanFunctionName :: FunctionName -> (Name, [CVQualifier])
cleanFunctionName :: FunctionName -> (Name, [CVQualifier])
cleanFunctionName (FunctionName Name
nm) =
  case Name
nm of
    NameNested (NestedName Prefix
p UnqualifiedName
u [CVQualifier]
cvq Maybe RefQualifier
mbrq) ->
      (NestedName -> Name
NameNested forall a b. (a -> b) -> a -> b
$ Prefix
-> UnqualifiedName
-> [CVQualifier]
-> Maybe RefQualifier
-> NestedName
NestedName Prefix
p UnqualifiedName
u [] Maybe RefQualifier
mbrq, [CVQualifier]
cvq)
    NameNested (NestedTemplateName TemplatePrefix
tp NonEmpty TemplateArg
ta [CVQualifier]
cvq Maybe RefQualifier
mbrq) ->
      (NestedName -> Name
NameNested forall a b. (a -> b) -> a -> b
$ TemplatePrefix
-> NonEmpty TemplateArg
-> [CVQualifier]
-> Maybe RefQualifier
-> NestedName
NestedTemplateName TemplatePrefix
tp NonEmpty TemplateArg
ta [] Maybe RefQualifier
mbrq, [CVQualifier]
cvq)
    Name
_ -> (Name
nm, [])

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''SpecialName
  ) => Sayable saytag (WithContext SpecialName) where
  sayable :: WithContext SpecialName -> Saying saytag
sayable (WC SpecialName
n Context
c) =
    case SpecialName
n of
      VirtualTable Type_
ty -> Text -> Text
t'Text
"vtable for" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Type_
ty Context
c
      TemplateParameterObj TemplateArg
ta -> Text -> Text
t'Text
"template parameter object for" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC TemplateArg
ta Context
c
      VTT Type_
ty -> Text -> Text
t'Text
"VTT for" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Type_
ty Context
c
      TypeInfo Type_
ty -> Text -> Text
t'Text
"typeinfo for" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Type_
ty Context
c
      TypeInfoName Type_
ty -> Text -> Text
t'Text
"typeinfo name for" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Type_
ty Context
c
      CtorVTable ()
_ -> Text -> Text
t'Text
"construction vtable for" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text -> Text
t'Text
"()"
      Thunk (VirtualOffset Coord
_o1 Coord
_o2) Encoding
enc -> Text -> Text
t'Text
"virtual thunk to" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Encoding
enc Context
c
      Thunk (NonVirtualOffset Coord
_o1) Encoding
enc -> Text -> Text
t'Text
"non-virtual thunk to" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Encoding
enc Context
c


instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''FunctionName
  ) => Sayable saytag (WithContext FunctionName) where
  sayable :: WithContext FunctionName -> Saying saytag
sayable (WC FunctionName
n Context
c) = forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC FunctionName
n Context
c


instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''Name
  ) => Sayable saytag (WithContext Name) where
  sayable :: WithContext Name -> Saying saytag
sayable (WC Name
n Context
c) =
    case Name
n of
      NameNested NestedName
nn -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC NestedName
nn Context
c
      UnscopedName Bool
False UnqualifiedName
uqn -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC UnqualifiedName
uqn Context
c
      UnscopedName Bool
True UnqualifiedName
uqn -> Text -> Text
t'Text
"std::" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC UnqualifiedName
uqn Context
c
      UnscopedTemplateName Name
nn NonEmpty TemplateArg
ta -> forall a. a -> Context -> WithContext a
WC Name
nn Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC NonEmpty TemplateArg
ta Context
c
      LocalName Coord
fs Coord
fe Maybe Coord
mbd -> forall a. a -> Context -> WithContext a
WC Coord
fs Context
c  forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"::" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Coord
fe Context
c forall (tag :: Symbol) m e.
(Sayable tag m, Sayable tag e) =>
m -> Maybe e -> Saying tag
&? forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx Maybe Coord
mbd Context
c -- ??
      StringLitName Coord
fs Maybe Coord
mbd -> forall a. a -> Context -> WithContext a
WC Coord
fs Context
c forall (tag :: Symbol) m e.
(Sayable tag m, Sayable tag e) =>
m -> Maybe e -> Saying tag
&? forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx Maybe Coord
mbd Context
c -- ??


instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext Coord) where
  sayable :: WithContext Coord -> Saying saytag
sayable (WC Coord
i Context
c) = forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Context -> Coord -> Text
contextStr Context
c Coord
i


instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''UnqualifiedName
  ) =>  Sayable saytag (WithContext UnqualifiedName) where
  sayable :: WithContext UnqualifiedName -> Saying saytag
sayable (WC UnqualifiedName
n Context
c) =
    case UnqualifiedName
n of
      SourceName SourceName
i [] -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC SourceName
i Context
c
      SourceName SourceName
i [ABI_Tag]
tags -> forall a. a -> Context -> WithContext a
WC SourceName
i Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [ABI_Tag]
tags Context
c Text
""
      OperatorName Operator
op [] -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Operator
op Context
c
      OperatorName Operator
op [ABI_Tag]
tags -> forall a. a -> Context -> WithContext a
WC Operator
op Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [ABI_Tag]
tags Context
c Text
""
      CtorDtorName CtorDtor
cd -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC CtorDtor
cd Context
c
      StdSubst Substitution
subs -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Substitution
subs Context
c
      ModuleNamed [ModuleName]
mn UnqualifiedName
uqn -> forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [ModuleName]
mn Context
c Text
"" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC UnqualifiedName
uqn Context
c

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''SourceName
   ) => Sayable saytag (WithContext SourceName) where
  sayable :: WithContext SourceName -> Saying saytag
sayable (WC (SrcName Coord
i) Context
c) = forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Context -> Coord -> Text
contextStr Context
c Coord
i


instance {-# OVERLAPPABLE #-}
  ($(sayableConstraints ''PrefixUQN)
  , Sayable saytag (WithContext PrefixCDtor)
  ) =>  Sayable saytag (WithContext PrefixUQN) where
  sayable :: WithContext PrefixUQN -> Saying saytag
sayable (WC (PUC Prefix
p UnqualifiedName
n) Context
c) =
    case UnqualifiedName
n of
      CtorDtorName CtorDtor
cd -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC (Prefix -> CtorDtor -> PrefixCDtor
PCDC Prefix
p CtorDtor
cd) Context
c
      UnqualifiedName
_ -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC UnqualifiedName
n Context
c

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''ModuleName
  ) => Sayable saytag (WithContext ModuleName) where
  sayable :: WithContext ModuleName -> Saying saytag
sayable (WC (ModuleName Bool
isP SourceName
sn) Context
c) =
    if Bool
isP
    then forall a. a -> Context -> WithContext a
WC SourceName
sn Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
':'
    else forall a. a -> Context -> WithContext a
WC SourceName
sn Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'.'

{- | Use Sayable (Prefix, CtorDtor, Context) instead, since CtorDtor needs to
   reproduce Prefix name. -}
instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''CtorDtor
   ) =>  Sayable saytag (WithContext CtorDtor) where
  sayable :: WithContext CtorDtor -> Saying saytag
sayable (WC CtorDtor
n Context
c) =
    case CtorDtor
n of
      CtorDtor
CompleteCtor -> Char
'c' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'1'
      CtorDtor
BaseCtor -> Char
'c' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'2'
      CtorDtor
CompleteAllocatingCtor -> Char
'c' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'3'
      CompleteInheritingCtor Type_
t -> Text -> Text
t'Text
"ci1" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Type_
t Context
c
      BaseInheritingCtor Type_
t -> Text -> Text
t'Text
"ci2" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Type_
t Context
c
      CtorDtor
DeletingDtor -> Char
'd' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'0'
      CtorDtor
CompleteDtor -> Char
'd' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'1'
      CtorDtor
BaseDtor -> Char
'd' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'2'

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''PrefixCDtor
  ) =>  Sayable saytag (WithContext PrefixCDtor) where
  sayable :: WithContext PrefixCDtor -> Saying saytag
sayable (WC (PCDC Prefix
p CtorDtor
n) Context
c) =
    let mb'ln :: Maybe UnqualifiedName
mb'ln = case Prefix
p of
                  Prefix PrefixR
pfxr -> PrefixR -> Maybe UnqualifiedName
pfxrLastUQName PrefixR
pfxr
                  Prefix
_ -> forall a b. a -> String -> [String] -> Maybe b
cannot Demangler
Demangler String
"sayable"
                       [ String
"CTORDTOR UNK PFX: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Prefix
p ]
        pfxrLastUQName :: PrefixR -> Maybe UnqualifiedName
pfxrLastUQName = \case
          PrefixUQName UnqualifiedName
unm PrefixR
PrefixEnd -> forall a. a -> Maybe a
Just UnqualifiedName
unm
          PrefixUQName UnqualifiedName
unm (PrefixTemplateArgs NonEmpty TemplateArg
_ PrefixR
PrefixEnd) -> forall a. a -> Maybe a
Just UnqualifiedName
unm
          PrefixUQName UnqualifiedName
_ PrefixR
sp -> PrefixR -> Maybe UnqualifiedName
pfxrLastUQName PrefixR
sp
          PrefixTemplateArgs NonEmpty TemplateArg
_ PrefixR
sp -> PrefixR -> Maybe UnqualifiedName
pfxrLastUQName PrefixR
sp
          PrefixR
PrefixEnd -> forall a. Maybe a
Nothing
    in case Maybe UnqualifiedName
mb'ln of
         Just UnqualifiedName
ln ->
           case CtorDtor
n of
             CtorDtor
CompleteCtor -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC UnqualifiedName
ln Context
c
             CtorDtor
BaseCtor -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC UnqualifiedName
ln Context
c
             CtorDtor
CompleteAllocatingCtor -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC UnqualifiedName
ln Context
c
             CompleteInheritingCtor Type_
t -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Type_
t Context
c -- ??
             BaseInheritingCtor Type_
t -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Type_
t Context
c -- ??
             CtorDtor
DeletingDtor -> Char
'~' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC UnqualifiedName
ln Context
c
             CtorDtor
CompleteDtor -> Char
'~' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC UnqualifiedName
ln Context
c
             CtorDtor
BaseDtor -> Char
'~' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC UnqualifiedName
ln Context
c
         Maybe UnqualifiedName
Nothing -> Text -> Text
t'Text
"unk_" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC CtorDtor
n Context
c -- unlikely... and will be wrong


instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''Operator
  ) =>  Sayable saytag (WithContext Operator) where
  sayable :: WithContext Operator -> Saying saytag
sayable (WC Operator
op Context
c) =
    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Operator
op [(Operator, (Text, Text))]
opTable of
      Just (Text
_, Text
o) -> Text -> Text
t'Text
"operator" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text
o
      Maybe (Text, Text)
Nothing ->
        case Operator
op of
          OpCast Type_
ty -> Text -> Text
t'Text
"operator" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Type_
ty Context
c
          OpString SourceName
snm -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC SourceName
snm Context
c
          OpVendor Natural
n SourceName
snm -> Text -> Text
t'Text
"vendor" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Natural
n forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC SourceName
snm Context
c
          Operator
_ -> forall a (saytag :: Symbol).
a -> String -> [String] -> Saying saytag
cannotSay Demangler
Demangler String
"sayable"
               [ String
"Operator not in opTable or with a specific override:"
               , forall a. Show a => a -> String
show Operator
op
               ]

instance {-# OVERLAPPABLE #-}
  ($(sayableConstraints ''NestedName)
  , Sayable saytag (WithContext PrefixCDtor)
  ) => Sayable saytag (WithContext NestedName) where
  sayable :: WithContext NestedName -> Saying saytag
sayable (WC NestedName
n Context
c) =
    let qualrefs :: [CVQualifier] -> Maybe RefQualifier -> Saying saytag
qualrefs [CVQualifier]
q Maybe RefQualifier
r = forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [CVQualifier]
q Context
c Text
" " forall (tag :: Symbol) m e.
(Sayable tag m, Sayable tag e) =>
m -> Maybe e -> Saying tag
&? forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx Maybe RefQualifier
r Context
c
    in case NestedName
n of
      NestedName Prefix
p (CtorDtorName CtorDtor
nm) [CVQualifier]
q Maybe RefQualifier
r ->
        [CVQualifier] -> Maybe RefQualifier -> Saying saytag
qualrefs [CVQualifier]
q Maybe RefQualifier
r forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Prefix
p Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"::" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC (Prefix -> CtorDtor -> PrefixCDtor
PCDC Prefix
p CtorDtor
nm) Context
c
      NestedName Prefix
EmptyPrefix UnqualifiedName
nm [CVQualifier]
q Maybe RefQualifier
r -> [CVQualifier] -> Maybe RefQualifier -> Saying saytag
qualrefs [CVQualifier]
q Maybe RefQualifier
r forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC UnqualifiedName
nm Context
c
      NestedName Prefix
p UnqualifiedName
nm [CVQualifier]
q Maybe RefQualifier
r -> [CVQualifier] -> Maybe RefQualifier -> Saying saytag
qualrefs [CVQualifier]
q Maybe RefQualifier
r forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Prefix
p Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"::" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC UnqualifiedName
nm Context
c
      NestedTemplateName TemplatePrefix
tp NonEmpty TemplateArg
ta [CVQualifier]
q Maybe RefQualifier
r -> [CVQualifier] -> Maybe RefQualifier -> Saying saytag
qualrefs [CVQualifier]
q Maybe RefQualifier
r forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC TemplatePrefix
tp Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC NonEmpty TemplateArg
ta Context
c


instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''Prefix
  ) => Sayable saytag (WithContext Prefix) where
  sayable :: WithContext Prefix -> Saying saytag
sayable (WC Prefix
p Context
c) =
    case Prefix
p of
      PrefixTemplateParam TemplateArg
tp PrefixR
prefixr -> forall a. a -> Context -> WithContext a
WC TemplateArg
tp Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC PrefixR
prefixr Context
c
      PrefixDeclType ()
dt PrefixR
prefixr -> forall a. a -> Context -> WithContext a
WC ()
dt Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC PrefixR
prefixr Context
c
      PrefixClosure ()
cp -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC ()
cp Context
c -- ??
      Prefix PrefixR
prefixr -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC PrefixR
prefixr Context
c

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''PrefixR
  ) => Sayable saytag (WithContext PrefixR) where
  sayable :: WithContext PrefixR -> Saying saytag
sayable (WC PrefixR
p Context
c) =
    case PrefixR
p of
      PrefixUQName UnqualifiedName
uqn pfr :: PrefixR
pfr@(PrefixUQName {}) -> forall a. a -> Context -> WithContext a
WC UnqualifiedName
uqn Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"::" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC PrefixR
pfr Context
c
      PrefixUQName UnqualifiedName
uqn PrefixR
pfr -> forall a. a -> Context -> WithContext a
WC UnqualifiedName
uqn Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC PrefixR
pfr Context
c
      PrefixTemplateArgs NonEmpty TemplateArg
ta PrefixR
pfr -> forall a. a -> Context -> WithContext a
WC NonEmpty TemplateArg
ta Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC PrefixR
pfr Context
c
      PrefixR
PrefixEnd -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
""


instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext CVQualifier) where
  sayable :: WithContext CVQualifier -> Saying saytag
sayable (WC CVQualifier
q Context
_c) =
    case CVQualifier
q of
      CVQualifier
Restrict -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
"restrict"
      CVQualifier
Volatile -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
"volatile"
      CVQualifier
Const_ -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
"const"

instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext RefQualifier) where
  sayable :: WithContext RefQualifier -> Saying saytag
sayable (WC RefQualifier
q Context
_c) =
    case RefQualifier
q of
      RefQualifier
Ref -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag Char
'&'
      RefQualifier
RefRef -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
"&&"

instance {-# OVERLAPPABLE #-}
  ($(sayableConstraints ''TemplatePrefix)
  , Sayable saytag (WithContext PrefixUQN)
  ) => Sayable saytag (WithContext TemplatePrefix) where
  sayable :: WithContext TemplatePrefix -> Saying saytag
sayable (WC TemplatePrefix
p Context
c) =
    case TemplatePrefix
p of
      GlobalTemplate NonEmpty UnqualifiedName
uqns -> forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' NonEmpty UnqualifiedName
uqns Context
c Text
"::"
      NestedTemplate Prefix
pr NonEmpty UnqualifiedName
uqns -> forall a. a -> Context -> WithContext a
WC Prefix
pr Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"::"
                                forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' (Prefix -> UnqualifiedName -> PrefixUQN
PUC Prefix
pr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty UnqualifiedName
uqns) Context
c Text
"::"
      TemplateTemplateParam TemplateArg
tp -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC TemplateArg
tp Context
c


instance {-# OVERLAPPABLE #-}
  (Sayable saytag (WithContext TemplateArg)
  ) => Sayable saytag (WithContext TemplateArgs) where
  sayable :: WithContext (NonEmpty TemplateArg) -> Saying saytag
sayable (WC NonEmpty TemplateArg
args Context
c) = Char
'<' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall (saytag :: Symbol) (t :: * -> *) a.
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Saying saytag
ctxLst NonEmpty TemplateArg
args Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ NonEmpty TemplateArg -> String
templateArgsEnd NonEmpty TemplateArg
args

-- C++ requires a space between template argument closures to resolve the parsing
-- ambiguity between that and a right shift operation.(e.g. "list<foo<int> >"
-- instead of "list<foo<int>>"
templateArgsEnd :: TemplateArgs -> String
templateArgsEnd :: NonEmpty TemplateArg -> String
templateArgsEnd NonEmpty TemplateArg
args = case forall a. NonEmpty a -> a
NEL.last NonEmpty TemplateArg
args of
                        TArgPack [TemplateArg]
targs ->
                          case forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [TemplateArg]
targs of
                            Just NonEmpty TemplateArg
args' -> NonEmpty TemplateArg -> String
templateArgsEnd NonEmpty TemplateArg
args'
                            -- Expected to need ellipsis here, but c++filt does
                            -- not emit them.
                            -- Nothing -> "..."
                            Maybe (NonEmpty TemplateArg)
Nothing -> String
">"
                        TArgType (ClassUnionStructEnum
                                  (NameNested
                                   (NestedTemplateName {}))) -> String
" >"
                        TArgType (ClassUnionStructEnum
                                  (UnscopedTemplateName {})) -> String
" >"
                        TemplateArg
_ -> String
">"

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''TemplateArg
  ) => Sayable saytag (WithContext TemplateArg) where
  sayable :: WithContext TemplateArg -> Saying saytag
sayable (WC TemplateArg
p Context
c) =
    case TemplateArg
p of
      TArgType Type_
ty -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Type_
ty Context
c
      TArgSimpleExpr ExprPrimary
ep -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC ExprPrimary
ep Context
c
      TArgExpr Expression
expr -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Expression
expr Context
c
      TArgPack [TemplateArg]
tas ->
        -- Expected some ellipses (see
        -- https://en.cppreference.com/w/cpp/language/parameter-pack), but
        -- c++filt does not show them in that manner.
        --
        -- if null tas  then '.' &+ ".."
        -- else (NEL.fromList tas, c) &+ "..."
        --
        -- Do not simply defer to the TemplateArgs sayable because that will
        -- engender another pair of surrounding angle brackets.
        forall (saytag :: Symbol) (t :: * -> *) a.
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Saying saytag
ctxLst [TemplateArg]
tas Context
c

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''Expression
  ) => Sayable saytag (WithContext Expression) where
  sayable :: WithContext Expression -> Saying saytag
sayable (WC Expression
e Context
c) =
    case Expression
e of
      ExprPack Expression
expr -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Expression
expr Context
c
      ExprTemplateParam TemplateArg
tp -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC TemplateArg
tp Context
c
      ExprPrim ExprPrimary
pe -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC ExprPrimary
pe Context
c


instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''ExprPrimary
  ) => Sayable saytag (WithContext ExprPrimary) where
  sayable :: WithContext ExprPrimary -> Saying saytag
sayable (WC ExprPrimary
e Context
c) =
    case ExprPrimary
e of
      IntLit Type_
ty Coord
n ->
        -- Normally these are printed with a typecast (e.g. `(type)`) ".
        -- However, C and C++ have some special situations where they can use
        -- special suffixes instead (e.g. `10ul` for unsigned long).  And some
        -- are just wholesale changes.
        case Type_
ty of
          BaseType BaseType
Bool_ -> Text -> Text
t'Text
"" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ if Coord
n forall a. Ord a => a -> a -> Bool
> Coord
0 then Text -> Text
t'Text
"true" else Text -> Text
t'Text
"false"
          BaseType BaseType
bty -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup BaseType
bty [(BaseType, (Text, Text, Text))]
builtinTypeTable of
                            Just (Text
_, Text
cst, Text
sfx) -> if Text -> Bool
T.null Text
sfx
                                                  then Char
'(' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text
cst forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Coord
n
                                                  else Coord
n forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text
sfx
                            Maybe (Text, Text, Text)
_ -> Char
'(' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Type_
ty Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Coord
n
          Type_
_ -> Char
'(' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Type_
ty Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Coord
n
      FloatLit Type_
ty Float
n -> Char
'(' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Type_
ty Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Float
n
      ComplexFloatLit Type_
ty Float
r Float
i -> Char
'(' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Type_
ty Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'(' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Float
r forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
',' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Float
i forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')'
      DirectLit Type_
ty -> Char
'(' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Type_
ty Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
")NULL"  -- except String?
      NullPtrTemplateArg Type_
ty -> Char
'(' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Type_
ty Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
")0"
      ExternalNameLit Encoding
enc -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Encoding
enc Context
c


instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext ClosurePrefix) where
  sayable :: WithContext () -> Saying saytag
sayable (WC ()
_p Context
_c) = forall a (saytag :: Symbol).
a -> String -> [String] -> Saying saytag
cannotSay Demangler
Demangler String
"sayable"
                       [ String
"No Sayable for ClosurePrefix" ]

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''Substitution
  ) => Sayable saytag (WithContext Substitution) where
  sayable :: WithContext Substitution -> Saying saytag
sayable (WC Substitution
p Context
c) =
    case Substitution
p of
      Substitution
SubStd -> Text -> Text
t'Text
"std" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
""
      Substitution
SubAlloc -> Text -> Text
t'Text
"std" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"::allocator"
      Substitution
SubBasicString -> Text -> Text
t'Text
"std" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"::basic_string"
      SubStdType StdType
stdTy -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC StdType
stdTy Context
c

instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext StdType) where
  sayable :: WithContext StdType -> Saying saytag
sayable (WC StdType
stdTy Context
_c) =
    let ct :: Text
ct = Text -> Text
t'Text
"std::char_traits<char>" in
    case StdType
stdTy of
      StdType
BasicStringChar -> Text -> Text
t'Text
"std::basic_string<char," forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text
ct forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
", std::allocator<char> >"
      StdType
BasicIStream -> Text -> Text
t'Text
"std::basic_istream<char," forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text
ct forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Char
'>'
      StdType
BasicOStream -> Text -> Text
t'Text
"std::basic_ostream<char," forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text
ct forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Char
'>'
      StdType
BasicIOStream -> Text -> Text
t'Text
"std::basic_iostream<char," forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text
ct forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Char
'>'


-- n.b. LLVM and GNU syntax seems to be [abi:foo][abi:bar], despite the website
-- documentation of [[gnu::abi_tag ("foo", "bar")]]
instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''ABI_Tag
  ) => Sayable saytag (WithContext ABI_Tag) where
  sayable :: WithContext ABI_Tag -> Saying saytag
sayable (WC (ABITag SourceName
p) Context
c) = Text -> Text
t'Text
"[abi:" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC SourceName
p Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
']'

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''Type_
 ) => Sayable saytag (WithContext Type_) where
  sayable :: WithContext Type_ -> Saying saytag
sayable (WC Type_
ty Context
c) =
    case Type_
ty of
      BaseType BaseType
t -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC BaseType
t Context
c
      QualifiedType [] [] Type_
t -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Type_
t Context
c
      QualifiedType [()]
eqs [] Type_
t -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [()]
eqs Context
c Text
" "
      QualifiedType [] [CVQualifier]
cvqs Type_
t -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [CVQualifier]
cvqs Context
c Text
" "
      QualifiedType [()]
eqs [CVQualifier]
cvqs Type_
t -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [()]
eqs Context
c Text
" " forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [CVQualifier]
cvqs Context
c Text
" "
      ClassUnionStructEnum Name
n -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Name
n Context
c
      ClassStruct Name
n -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Name
n Context
c
      Union Name
n -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Name
n Context
c
      Enum Name
n -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Name
n Context
c
      Function {} -> forall (saytag :: Symbol).
Type_ -> Text -> Context -> Saying saytag
sayFunctionType Type_
ty Text
"" Context
c
      Pointer f :: Type_
f@(Function {}) -> forall (saytag :: Symbol).
Type_ -> Text -> Context -> Saying saytag
sayFunctionType Type_
f Text
"(*)" Context
c
      Pointer (ArrayType ArrayBound
bnd Type_
t) -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text -> Text
t'Text
"(*)" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Char
'[' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC ArrayBound
bnd Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
']'
      Pointer Type_
t -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'*'
      LValRef (ArrayType ArrayBound
bnd Type_
t) -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text -> Text
t'Text
"(&)" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Char
'[' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC ArrayBound
bnd Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
']'
      LValRef Type_
t -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'&'
      RValRef Type_
t -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"&&"
      ComplexPair Type_
t -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text -> Text
t'Text
"complex"
      Imaginary Type_
t -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text -> Text
t'Text
"imaginary"
      ArrayType ArrayBound
bnd Type_
t -> forall a. a -> Context -> WithContext a
WC Type_
t Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'[' forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC ArrayBound
bnd Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
']'
      Template TemplateArg
tp NonEmpty TemplateArg
ta -> forall a. a -> Context -> WithContext a
WC TemplateArg
tp Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC NonEmpty TemplateArg
ta Context
c -- ??
      Cpp11PackExpansion NonEmpty Type_
ts ->
        -- XXX expected some "..." (see
        -- https://en.cppreference.com/w/cpp/language/parameter-pack) but c++filt
        -- does not visibly decorate these.
        forall (saytag :: Symbol) (t :: * -> *) a.
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Saying saytag
ctxLst NonEmpty Type_
ts Context
c
      StdType StdType
stdTy -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC StdType
stdTy Context
c


sayFunctionType :: Type_ -> Text -> Context -> Saying saytag
sayFunctionType :: forall (saytag :: Symbol).
Type_ -> Text -> Context -> Saying saytag
sayFunctionType (Function [CVQualifier]
cvqs Maybe ExceptionSpec
mb'exc Transaction
trns Bool
isExternC Type_
rTy NonEmpty Type_
argTys Maybe RefQualifier
mb'ref) Text
nm Context
c =
  forall (saytag :: Symbol) a (t :: * -> *).
(Sayable saytag (WithContext a), Functor t, Foldable t) =>
t a -> Context -> Text -> Saying saytag
ctxLst' [CVQualifier]
cvqs Context
c Text
" "
  forall (tag :: Symbol) m e.
(Sayable tag m, Sayable tag e) =>
m -> Maybe e -> Saying tag
&? forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx Maybe ExceptionSpec
mb'exc Context
c
  forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Transaction
trns Context
c
  forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ (if Bool
isExternC then Text -> Text
t'Text
" extern \"C\"" else Text -> Text
t'Text
"")
  forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC Type_
rTy Context
c
  forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text
nm forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'('
  forall (tag :: Symbol) m e (t :: * -> *).
(Sayable tag m, Sayable tag e, Foldable t) =>
m -> t e -> Saying tag
&+* (case NonEmpty Type_
argTys of
          BaseType BaseType
Void :| [] -> []
          NonEmpty Type_
_ -> forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx (forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Type_
argTys) Context
c
      )
  forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')'
  forall (tag :: Symbol) m e.
(Sayable tag m, Sayable tag e) =>
m -> Maybe e -> Saying tag
&? forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx Maybe RefQualifier
mb'ref Context
c
sayFunctionType Type_
_ Text
_ Context
_ = forall a (saytag :: Symbol).
a -> String -> [String] -> Saying saytag
cannotSay Demangler
Demangler String
"sayFunctionType"
                        [ String
"Called with a type that is not a Function!" ]


instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''ArrayBound
  ) => Sayable saytag (WithContext ArrayBound) where
  sayable :: WithContext ArrayBound -> Saying saytag
sayable (WC ArrayBound
n Context
c) =
    case ArrayBound
n of
      ArrayBound
NoBounds -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
""
      NumBound Coord
i -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag Coord
i
      ExprBound Expression
e -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ forall a. a -> Context -> WithContext a
WC Expression
e Context
c


instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''ExceptionSpec
  ) => Sayable saytag (WithContext ExceptionSpec) where
  sayable :: WithContext ExceptionSpec -> Saying saytag
sayable (WC ExceptionSpec
exc Context
c) =
    case ExceptionSpec
exc of
      ExceptionSpec
NonThrowing -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
"noexcept"
      ComputedThrow Expression
expr -> Text -> Text
t'Text
"throw" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Expression
expr Context
c -- ?
      Throwing NonEmpty Type_
tys -> Text -> Text
t'Text
"throw (" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx NonEmpty Type_
tys Context
c forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')' -- ?

instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext Transaction) where
  sayable :: WithContext Transaction -> Saying saytag
sayable (WC Transaction
trns Context
_c) =
    case Transaction
trns of
      Transaction
TransactionSafe -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
"safe" -- ?
      Transaction
TransactionUnsafe -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
""

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''BaseType
  ) => Sayable saytag (WithContext BaseType) where
  sayable :: WithContext BaseType -> Saying saytag
sayable (WC BaseType
t Context
c) =
    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup BaseType
t [(BaseType, (Text, Text, Text))]
builtinTypeTable of
      Just (Text
_,Text
s,Text
_) -> forall (tag :: Symbol) v. Sayable tag v => v -> Saying tag
sayable @saytag Text
s
      Maybe (Text, Text, Text)
Nothing ->
        case BaseType
t of
          FloatN Natural
n -> Text -> Text
t'Text
"std::float" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Natural
n forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"_t"
          FloatNx Natural
n -> Text -> Text
t'Text
"std::float" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Natural
n forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Text -> Text
t'Text
"x_t"
          SBitInt Natural
n -> Text -> Text
t'Text
"signed _BitInt(" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Natural
n forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')'
          UBitInt Natural
n -> Text -> Text
t'Text
"unsigned _BitInt(" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Natural
n forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
')'
          VendorExtendedType SourceName
nm Maybe (NonEmpty TemplateArg)
mb'ta -> forall a. a -> Context -> WithContext a
WC SourceName
nm Context
c forall (tag :: Symbol) m e.
(Sayable tag m, Sayable tag e) =>
m -> Maybe e -> Saying tag
&? forall (t :: * -> *) a.
Functor t =>
t a -> Context -> t (WithContext a)
wCtx Maybe (NonEmpty TemplateArg)
mb'ta Context
c
          BaseType
_ -> forall a (saytag :: Symbol).
a -> String -> [String] -> Saying saytag
cannotSay Demangler
Demangler String
"sayable.Basetype"
               [ String
"Unknown BaseType not listed in the builtinTypeTable"
               , forall a. Show a => a -> String
show BaseType
t
               ]

instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext CallOffset) where
  sayable :: WithContext CallOffset -> Saying saytag
sayable (WC CallOffset
_co Context
_c) =
    forall a (saytag :: Symbol).
a -> String -> [String] -> Saying saytag
cannotSay Demangler
Demangler String
"Sayable CallOffset"
    [ String
"The CallOffset is for a thunk or covariant return thunk"
    , String
"and is not expected to be printed."
    ]

instance {-# OVERLAPPABLE #-}
  $(sayableConstraints ''SubsCandidate
  ) => Sayable saytag (WithContext SubsCandidate) where
  sayable :: WithContext SubsCandidate -> Saying saytag
sayable (WC SubsCandidate
cand Context
c) = -- For debug only
    case SubsCandidate
cand of
      SC_Type Type_
t -> Text -> Text
t'Text
"SC_Ty" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Type_
t Context
c
      SC_UQName Bool
True UnqualifiedName
n -> Text -> Text
t'Text
"SC_UN" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- Text -> Text
t'Text
"std::" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ forall a. a -> Context -> WithContext a
WC UnqualifiedName
n Context
c
      SC_UQName Bool
_ UnqualifiedName
n -> Text -> Text
t'Text
"SC_UN" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC UnqualifiedName
n Context
c
      SC_Prefix Prefix
p -> Text -> Text
t'Text
"SC_PR" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC Prefix
p Context
c
      SC_TemplatePrefix TemplatePrefix
tp -> Text -> Text
t'Text
"SC_TP" forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&- forall a. a -> Context -> WithContext a
WC TemplatePrefix
tp Context
c