{-# LANGUAGE LambdaCase #-}

module ABI.Itanium.Pretty (
  cxxNameToString,
  cxxNameToText,
  -- * Exceptions thrown
  MissingSubstitution,
  CtorDtorFallthru,
  UnqualCtorDtor,
  NonPointerFunctionType,
  BarePtrToMember,
  EmptyFunctionType
  ) where

import Control.Monad ( foldM, unless, void )
import Control.Monad.Catch ( Exception, MonadThrow, throwM )
import Control.Monad.Trans.State.Strict
import Data.Char ( ord )
import Data.List ( intersperse )
import Data.HashMap.Strict ( HashMap )
import qualified Data.HashMap.Strict as HM
import Data.Maybe ( catMaybes )
import Data.Text.Lazy ( Text, unpack, unsnoc )
import Data.Text.Lazy.Builder

import ABI.Itanium.Types


-- | The Store maintains the substitution table used for emitting a
-- demangled names.  For compression, demangling allows the use of
-- "substitutions" to refer to previously emitted portions of the
-- name.  Most portions of the name that are emitted are recorded
-- (with compositional buildup: @foo::bar@ will record both @foo@ and
-- @foo::bar@).  The only exceptions to recording are function names
-- and builtin types.  As a name is demangled, each portion will be
-- added to this table for use in subsequent substitutions.

data Store = Store { Store -> HashMap Int Builder
substitutions :: HashMap Int Builder
                   , Store -> [Maybe Builder]
templateArgs :: [Maybe Builder]
                   }

emptyStore :: Store
emptyStore :: Store
emptyStore = HashMap Int Builder -> [Maybe Builder] -> Store
Store forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- | The Pretty type is used as the main State object for performing
-- conversion to pretty output with the Store as the internal state.

type Pretty = StateT Store

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

-- | Records a substitution component in the current table, skipping
-- any duplications.
--
-- For convenience, it returns the same item it recorded to allow this
-- to be the last statement for a Pretty Builder operation that should
-- record and return the generated output.
recordSubstitution :: Monad m => Builder -> Pretty m Builder
recordSubstitution :: forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution Builder
b = do
  Store
store <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  let s :: HashMap Int Builder
s = Store -> HashMap Int Builder
substitutions Store
store
  case Builder
b forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall k v. HashMap k v -> [v]
HM.elems HashMap Int Builder
s of
    Bool
False -> do
      let n :: Int
n = forall k v. HashMap k v -> Int
HM.size HashMap Int Builder
s
      let store' :: Store
store' = Store
store { substitutions :: HashMap Int Builder
substitutions = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Int
n Builder
b HashMap Int Builder
s }
      forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall a b. (a -> b) -> a -> b
$! Store
store'
      forall (m :: * -> *) a. Monad m => a -> m a
return Builder
b
    Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return Builder
b

-- | Called for special cases where a substitution should be recorded,
-- even if it is a duplicate of another already-recorded substitution.
recordSubstitutionAlways :: Monad m => Builder -> Pretty m Builder
recordSubstitutionAlways :: forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitutionAlways Builder
b = do
  Store
store <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  let s :: HashMap Int Builder
s = Store -> HashMap Int Builder
substitutions Store
store
  let n :: Int
n = forall k v. HashMap k v -> Int
HM.size HashMap Int Builder
s
  let store' :: Store
store' = Store
store { substitutions :: HashMap Int Builder
substitutions = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Int
n Builder
b HashMap Int Builder
s }
  forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall a b. (a -> b) -> a -> b
$! Store
store'
  forall (m :: * -> *) a. Monad m => a -> m a
return Builder
b

-- | This is a convenience wrapper for 'recordSubstitution' that will
-- return a void value; this can be used where the results of the
-- recording are not needed and the compiler would warn about an
-- unused return value.
recordSubstitution' :: Monad m => Builder -> Pretty m ()
recordSubstitution' :: forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution

-- | Function names are not recorded, but their prefixes are.  For example:
--
--    Input                          | Records
--    -------------------------------|--------------------------------
--    @foo(int)@                     | (nothing)
--                                   |
--    @bar::foo(int)@                | @bar@
--                                   |
--    @bar::cow<moo>::boo::foo(int)@ | @bar@ @bar::cow@ @bar::cow<moo>@
--                                   | @bar::cow<moo>::boo@
--
-- To support this, the various parts of the function call are
-- recorded as normal (using recursive, shared pretty printing) and
-- then this function is called to drop the last element recorded,
-- which is the actual function name.
dropLastSubstitution :: Monad m => Pretty m ()
dropLastSubstitution :: forall (m :: * -> *). Monad m => Pretty m ()
dropLastSubstitution = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \Store
store ->
  let s :: HashMap Int Builder
s = Store -> HashMap Int Builder
substitutions Store
store
      s' :: HashMap Int Builder
s' = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete ((forall k v. HashMap k v -> Int
HM.size HashMap Int Builder
s) forall a. Num a => a -> a -> a
- Int
1) HashMap Int Builder
s
  in Store
store { substitutions :: HashMap Int Builder
substitutions = HashMap Int Builder
s' }

-- | Lookup a recorded substitution and return it.  A lookup failure
-- means either a malformed mangled name (unlikely) or a logic error
-- below that did not properly record a substitution component.
getSubstitution :: (Monad m, MonadThrow m) => Maybe String -> Pretty m Builder
getSubstitution :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Maybe String -> Pretty m Builder
getSubstitution Maybe String
s = do
  HashMap Int Builder
st <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Store -> HashMap Int Builder
substitutions
  case Maybe String
s of
    Maybe String
Nothing -> forall {k} {a}. Hashable k => k -> HashMap k a -> StateT Store m a
lookupError Int
0 HashMap Int Builder
st
    -- This case always adds 1 from the number because the
    -- Nothing case is index zero
    Just String
ix ->
      -- seq ID is base 36
      case forall i. Integral i => Int -> String -> Maybe i
numberValue Int
36 String
ix of
        Just Int
n -> forall {k} {a}. Hashable k => k -> HashMap k a -> StateT Store m a
lookupError (Int
nforall a. Num a => a -> a -> a
+Int
1) HashMap Int Builder
st
        Maybe Int
Nothing -> forall {a}. StateT Store m a
errMsg
  where
    errMsg :: StateT Store m a
errMsg = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Maybe String -> MissingSubstitution
MissingSubstitution Maybe String
s
    lookupError :: k -> HashMap k a -> StateT Store m a
lookupError k
k HashMap k a
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. StateT Store m a
errMsg forall (m :: * -> *) a. Monad m => a -> m a
return (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
k HashMap k a
m)

-- | The MissingSubstitution exception is thrown when the mangled name
-- requests a substitution that cannot be found.  This indicates
-- either an invalid mangled name or else an internal logic error in
-- this Pretty implementation.

data MissingSubstitution = MissingSubstitution (Maybe String)
instance Exception MissingSubstitution
instance Show MissingSubstitution where
  show :: MissingSubstitution -> String
show (MissingSubstitution Maybe String
s) = String
"No substitution found for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe String
s



----------------------------------------------------------------------
-- * Template Argument handling
--
-- Template arguments are different than substitutions in that they
-- are numbered when the template opening character '<' is
-- seen/emitted, but the actual argument itself cannot be stored until
-- the closing character '>' is reached.  This means that if the
-- template argument itself contains template arguments, the arguments
-- processed during the recursion must follow the current argument.
--
--  Example:
--
--   foo<std::basic_string<char, std::char_traits<char>, std::allocator<char> > >
--       ^                 ^     ^                ^                     ^
--       |                 |     |                `-dup of T1, ignored--'
--       |                 T1    T2--------------------  T3------------------
--       T0--------------------------------------------------------------------
--
-- Further sophistication is needed to handle the case where
-- duplicates are observed.  For example, after T1 above, the '<'
-- following the char_traits reserves another template argument
-- position, but then when the '>' is reached, it can determine that
-- it's a duplicate and doesn't need to be recorded.  This is fine if
-- there were no other args recorded after the '<' and before the '>',
-- but consider the case where T0 might be discovered to be a
-- duplicate.  To resolve this, the template argument reservation adds
-- a Nothing to the reservation array, but lookups by index ignore
-- Nothing entries.

newtype ReservedTemplateArgument = RTA Int

-- | Reserves a template argument location
reserveTemplateArgument :: Monad m => Pretty m ReservedTemplateArgument
reserveTemplateArgument :: forall (m :: * -> *). Monad m => Pretty m ReservedTemplateArgument
reserveTemplateArgument = do
  Store
store <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  let tas :: [Maybe Builder]
tas = Store -> [Maybe Builder]
templateArgs Store
store
      nta :: Int
nta = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe Builder]
tas
  forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall a b. (a -> b) -> a -> b
$! Store
store { templateArgs :: [Maybe Builder]
templateArgs = Store -> [Maybe Builder]
templateArgs Store
store forall a. Semigroup a => a -> a -> a
<> [ forall a. Maybe a
Nothing ] }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int -> ReservedTemplateArgument
RTA Int
nta


-- | Records a template argument in the current table, skipping any
-- duplications.  Returns the input as a convenience pass-through.
recordTemplateArgument :: Monad m
                       => ReservedTemplateArgument -> Builder -> Pretty m Builder
recordTemplateArgument :: forall (m :: * -> *).
Monad m =>
ReservedTemplateArgument -> Builder -> Pretty m Builder
recordTemplateArgument (RTA Int
i) Builder
b = do
  Store
store <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  let tas :: [Maybe Builder]
tas = Store -> [Maybe Builder]
templateArgs Store
store
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe Builder]
tas) forall a b. (a -> b) -> a -> b
$
    forall a. HasCallStack => String -> a
error String
"INVALID TEMPLATE ARG RESERVATION: CODING ERROR"
  let ([Maybe Builder]
pre,Maybe Builder
_:[Maybe Builder]
post) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [Maybe Builder]
tas
  if forall a. a -> Maybe a
Just Builder
b forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Builder]
pre
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
b
    else do let store' :: Store
store' = Store
store { templateArgs :: [Maybe Builder]
templateArgs = [Maybe Builder]
pre forall a. Semigroup a => a -> a -> a
<> [ forall a. a -> Maybe a
Just Builder
b ] forall a. Semigroup a => a -> a -> a
<> [Maybe Builder]
post }
            forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall a b. (a -> b) -> a -> b
$! Store
store'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
b


-- | Lookup a recorded template argument and return it.  A lookup failure
-- means either a malformed mangled name (unlikely) or a logic error
-- below that did not properly record a substitution component.
getTemplateArgument :: (Monad m, MonadThrow m)
                    => Maybe String -> Pretty m Builder
getTemplateArgument :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Maybe String -> Pretty m Builder
getTemplateArgument Maybe String
s = do
  [Builder]
st <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Store -> [Maybe Builder]
templateArgs
  case Maybe String
s of
    Maybe String
Nothing -> forall {a}. Int -> [a] -> StateT Store m a
lookupError Int
0 [Builder]
st
    -- This case always adds 1 from the number because the
    -- Nothing case is index zero
    Just String
ix ->
      -- seq ID is base 36
      case forall i. Integral i => Int -> String -> Maybe i
numberValue Int
36 String
ix of
        Just Int
n -> forall {a}. Int -> [a] -> StateT Store m a
lookupError (Int
nforall a. Num a => a -> a -> a
+Int
1) [Builder]
st
        Maybe Int
Nothing -> forall {a}. StateT Store m a
errMsg
  where
    errMsg :: StateT Store m a
errMsg = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Maybe String -> MissingTemplateArgument
MissingTemplateArgument Maybe String
s
    lookupError :: Int -> [a] -> StateT Store m a
lookupError Int
k [a]
m = if Int
k forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
m
                      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a]
m forall a. [a] -> Int -> a
!! Int
k
                      else forall {a}. StateT Store m a
errMsg

-- | The MissingTemplateArgument exception is thrown when the mangled name
-- requests a template argument that cannot be found.  This indicates
-- either an invalid mangled name or else an internal logic error in
-- this Pretty implementation.

data MissingTemplateArgument = MissingTemplateArgument (Maybe String)
instance Exception MissingTemplateArgument
instance Show MissingTemplateArgument where
  show :: MissingTemplateArgument -> String
show (MissingTemplateArgument Maybe String
s) = String
"No template argument found for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe String
s


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

-- | Primary interface to get the pretty version of a parsed mangled
-- name in Text form.  This is a monadic operation to support throwing
-- an exception in that outer monad when there is a pretty-printing
-- conversion error.

cxxNameToText :: (Monad m, MonadThrow m) => DecodedName -> m Text
cxxNameToText :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecodedName -> m Text
cxxNameToText DecodedName
n = Builder -> Text
toLazyText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecodedName -> Pretty m Builder
dispatchTopLevel DecodedName
n) Store
emptyStore

-- | Primary interface to get the pretty version of a parsed mangled
-- name in String form.

cxxNameToString :: (Monad m, MonadThrow m) => DecodedName -> m String
cxxNameToString :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecodedName -> m String
cxxNameToString = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecodedName -> m Text
cxxNameToText

dispatchTopLevel :: (Monad m, MonadThrow m) => DecodedName -> Pretty m Builder
dispatchTopLevel :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecodedName -> Pretty m Builder
dispatchTopLevel DecodedName
n =
  case DecodedName
n of
    Function Name
fname [CXXType]
argTypes -> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> [CXXType] -> Pretty m Builder
showFunction Name
fname [CXXType]
argTypes
    ConstStructData UnqualifiedName
varName -> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UnqualifiedName -> Pretty m Builder
showUnqualifiedName UnqualifiedName
varName
    Data Name
varName -> do Builder
nm <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
varName
                       Builder
qual <- forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
nm Name
varName
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [Builder
nm, Builder
qual]
    VirtualTable CXXType
t -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"vtable for ", Builder
tb ]
    VTTStructure CXXType
t -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"<vttstruct for ", Builder
tb, Char -> Builder
singleton Char
'>' ]
    TypeInfo CXXType
t -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"typeinfo for ", Builder
tb ]
    TypeInfoName CXXType
t -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"typeinfo name for ", Builder
tb ]
    GuardVariable Name
vname -> do
      Builder
vn <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
vname
      Builder
vq <- forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
vn Name
vname
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"guard variable for ", Builder
vn, Builder
vq ]
    OverrideThunk CallOffset
_ DecodedName
target -> do
      Builder
tn <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecodedName -> Pretty m Builder
dispatchTopLevel DecodedName
target
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"non-virtual thunk to ", Builder
tn ]
    OverrideThunkCovariant CallOffset
_ CallOffset
_ DecodedName
target -> do
      Builder
tn <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecodedName -> Pretty m Builder
dispatchTopLevel DecodedName
target
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"virtual thunk to ", Builder
tn ]

-- | Show a Function and its arguments.  Function representation has
-- several rules:
--
--   1. template functions have return types with some exceptions
--
--   2. function types which are not part of a function name
--      mangling have return types with some exceptions
--
--   3. non-template function names do not have return types
--
-- The exceptions are that constructors, destructors, and conversion
-- operators do not have return types.
showFunction :: (Monad m, MonadThrow m)
             => Name -> [CXXType] -> Pretty m Builder
showFunction :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> [CXXType] -> Pretty m Builder
showFunction Name
fname [CXXType]
args =
  let (CXXType
retType:[CXXType]
retArgTypes) = [CXXType]
args
      argTypes :: [CXXType]
argTypes = if Name -> Bool
hasRetType Name
fname then [CXXType]
retArgTypes else [CXXType]
args
  in do Builder
nameBuilder <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
fname
        forall (m :: * -> *). Monad m => Pretty m ()
dropLastSubstitution
        Builder
retSpec <- if Name -> Bool
hasRetType Name
fname
                   then do Builder
p <- case [CXXType]
args of
                                  [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Builder
fromString String
"void"
                                  [CXXType]
_ -> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
retType
                           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
p, Char -> Builder
singleton Char
' ' ]
                   else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => a
mempty
        [Builder]
argBuilders <- case [CXXType]
argTypes of
          [CXXType
VoidType] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
          [CXXType]
_ -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType [CXXType]
argTypes
        let argSpec :: Builder
argSpec = forall a. Monoid a => [a] -> a
mconcat
                      forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (String -> Builder
fromString String
", ") [Builder]
argBuilders
        Builder
quals <- forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers forall a. Monoid a => a
mempty Name
fname
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
retSpec
                          , Builder
nameBuilder
                          , Char -> Builder
singleton Char
'(' , Builder
argSpec , Char -> Builder
singleton Char
')'
                          , Builder
quals
                          ]

hasRetType :: Name -> Bool
hasRetType :: Name -> Bool
hasRetType = \case
  NestedTemplateName {} -> Bool
True
  UnscopedTemplateName{} -> Bool
True
  Name
_ -> Bool
False

-- -- | There is a specific parse rule in older C++ that two
-- -- consecutive template closure brackets have to be separated by a
-- -- space.  This was changed in C++14, but the c++filt (i.e. the
-- -- reference standard) still emits the space separators.  This
-- -- function adds the brackets around template arguments, adding the
-- -- space separator for compatibility with c++filt and older C++.

templateBracket :: Builder -> Builder
templateBracket :: Builder -> Builder
templateBracket Builder
tmpltArgs =
  let lastIsTemplateClosure :: Builder -> Bool
lastIsTemplateClosure = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Char
'>' forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Text, Char)
unsnoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
  in Char -> Builder
singleton Char
'<' forall a. Monoid a => a -> a -> a
`mappend`
     if Builder -> Bool
lastIsTemplateClosure Builder
tmpltArgs
     then Builder
tmpltArgs forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
" >"
     else Builder
tmpltArgs forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
singleton Char
'>'

showName :: (Monad m, MonadThrow m) => Name -> Pretty m Builder
showName :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
n =
  case Name
n of
    NestedName [CVQualifier]
_ [Prefix]
pfxs UnqualifiedName
uname -> do
      Builder
pn <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[Prefix] -> UnqualifiedName -> Pretty m Builder
showPrefixedName [Prefix]
pfxs UnqualifiedName
uname
      forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution Builder
pn
    UnscopedName UName
uname -> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UName -> Pretty m Builder
showUName UName
uname
    NestedTemplateName [CVQualifier]
_ [Prefix]
pfxs [TemplateArg]
targs -> do
      Builder
p <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[Prefix] -> Pretty m Builder
showPrefixes [Prefix]
pfxs
      Builder
t <- Builder -> Builder
templateBracket forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
targs
      forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => a -> a -> a
mappend Builder
p Builder
t
    UnscopedTemplateName UName
uname [TemplateArg]
targs -> do
      Builder
un <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UName -> Pretty m Builder
showUName UName
uname
      forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
un
      Builder
tns <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
targs
      forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution forall a b. (a -> b) -> a -> b
$! Builder
un forall a. Monoid a => a -> a -> a
`mappend` Builder -> Builder
templateBracket Builder
tns
    UnscopedTemplateSubstitution Substitution
s [TemplateArg]
targs -> do
      Builder
ss <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Substitution -> Pretty m Builder
showSubstitution Substitution
s
      Builder
tns <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
targs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
ss forall a. Monoid a => a -> a -> a
`mappend` Builder -> Builder
templateBracket Builder
tns

showUName :: (Monad m, MonadThrow m) => UName -> Pretty m Builder
showUName :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UName -> Pretty m Builder
showUName UName
u =
  case UName
u of
    UName UnqualifiedName
uname -> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UnqualifiedName -> Pretty m Builder
showUnqualifiedName UnqualifiedName
uname
    UStdName UnqualifiedName
uname -> do
      Builder
un <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UnqualifiedName -> Pretty m Builder
showUnqualifiedName UnqualifiedName
uname
      forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Builder
fromString String
"std::" forall a. Monoid a => a -> a -> a
`mappend` Builder
un)

showNameQualifiers :: (Monad m)
                   => Builder -> Name -> Pretty m Builder
showNameQualifiers :: forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
pn = \case
  NestedName qs :: [CVQualifier]
qs@(CVQualifier
_:[CVQualifier]
_) [Prefix]
_ UnqualifiedName
_ ->
    forall a. Monoid a => a -> a -> a
mappend (forall a. Monoid a => [a] -> a
mconcat [ Builder
pn, Char -> Builder
singleton Char
' ' ]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
Builder -> [CVQualifier] -> Pretty m Builder
showQualifiers Builder
pn [CVQualifier]
qs
  NestedTemplateName qs :: [CVQualifier]
qs@(CVQualifier
_:[CVQualifier]
_) [Prefix]
_ [TemplateArg]
_ ->
    forall a. Monoid a => a -> a -> a
mappend (forall a. Monoid a => [a] -> a
mconcat [ Builder
pn, Char -> Builder
singleton Char
' ' ]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
Builder -> [CVQualifier] -> Pretty m Builder
showQualifiers Builder
pn [CVQualifier]
qs
  Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

showTArgs :: (Monad m, MonadThrow m) => [TemplateArg] -> Pretty m Builder
showTArgs :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
targs = do
  [Builder]
tns <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
(Monad m, MonadThrow m) =>
TemplateArg -> Pretty m Builder
showTArg [TemplateArg]
targs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$! forall a. a -> [a] -> [a]
intersperse (String -> Builder
fromString String
", ") [Builder]
tns

showTArg :: (Monad m, MonadThrow m) => TemplateArg -> Pretty m Builder
showTArg :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
TemplateArg -> Pretty m Builder
showTArg TemplateArg
ta =
  case TemplateArg
ta of
    TypeTemplateArg CXXType
t -> do ReservedTemplateArgument
tnum <- forall (m :: * -> *). Monad m => Pretty m ReservedTemplateArgument
reserveTemplateArgument
                            Builder
tt <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
                            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
ReservedTemplateArgument -> Builder -> Pretty m Builder
recordTemplateArgument ReservedTemplateArgument
tnum Builder
tt
                            forall (m :: * -> *) a. Monad m => a -> m a
return Builder
tt
    ExprPrimaryTemplateArg ExprPrimary
ep -> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
ExprPrimary -> Pretty m Builder
showExprPrimary ExprPrimary
ep

showExprPrimary :: (Monad m, MonadThrow m) => ExprPrimary -> Pretty m Builder
showExprPrimary :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
ExprPrimary -> Pretty m Builder
showExprPrimary =
  let parenShowType :: CXXType -> StateT Store m Builder
parenShowType CXXType
ty = do Builder
sty <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
ty
                            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Char -> Builder
singleton Char
'(', Builder
sty, Char -> Builder
singleton Char
')']
  in \case
    ExprIntLit CXXType
ty Int
intval ->
      case CXXType
ty of
        CXXType
BoolType
          | Int
intval forall a. Eq a => a -> a -> Bool
== Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"false"
          | Int
intval forall a. Eq a => a -> a -> Bool
== Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"true"
        CXXType
_ -> do Builder
sty <- forall {m :: * -> *}.
MonadThrow m =>
CXXType -> StateT Store m Builder
parenShowType CXXType
ty
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
sty
                                  , String -> Builder
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
intval ]

-- pass the current prefix builder down so that it can be added to and
-- stored for substitutions
showPrefixedName :: (Monad m, MonadThrow m)
                 => [Prefix] -> UnqualifiedName -> Pretty m Builder
showPrefixedName :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[Prefix] -> UnqualifiedName -> Pretty m Builder
showPrefixedName = forall {m :: * -> *}.
MonadThrow m =>
Builder -> [Prefix] -> UnqualifiedName -> StateT Store m Builder
go forall a. Monoid a => a
mempty
  where
    go :: Builder -> [Prefix] -> UnqualifiedName -> StateT Store m Builder
go Builder
acc [Prefix]
pfxs UnqualifiedName
uname =
      case ([Prefix]
pfxs, UnqualifiedName
uname) of
        ([], SourceName String
n) -> do
          forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
acc, String -> Builder
fromString String
"::", String -> Builder
fromString String
n ]
        ([], OperatorName Operator
op) -> do
          Builder
ob <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Operator -> Pretty m Builder
showOperator Operator
op
          forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
ob
          case Builder
acc forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty of
            Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
acc, String -> Builder
fromString String
"::operator", Builder
ob ]
            Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"operator", Builder
ob ]
        -- We need to handle constructors and destructors specially
        -- because we won't have enough information to build the right
        -- name if we do a fully depth-first traversal in isolation
        -- without context.  We recognize them here and short circuit
        -- some of the traversal to make things easier.
        ([UnqualifiedPrefix (SourceName String
className)], CtorDtorName CtorDtor
cd) -> do
          let curPfx :: Builder
curPfx =
                case Builder
acc forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty of
                  Bool
False -> Builder
acc forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
"::"
                  Bool
True -> forall a. Monoid a => a
mempty
              inFix :: Builder
inFix = case CtorDtor -> Bool
isDestructor CtorDtor
cd of
                Bool
False -> String -> Builder
fromString String
"::"
                Bool
True -> String -> Builder
fromString String
"::~"
              sub :: Builder
sub = Builder
curPfx forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
className
          forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
sub
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
curPfx, String -> Builder
fromString String
className, Builder
inFix, String -> Builder
fromString String
className ]
        ([UnqualifiedPrefix (SourceName String
className), tmplPfx :: Prefix
tmplPfx@(TemplateArgsPrefix{})], CtorDtorName CtorDtor
cd) -> do
          let prevPfx :: Builder -> Builder
prevPfx Builder
here = case Builder
acc forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty of
                               Bool
True -> Builder
here
                               Bool
False -> forall a. Monoid a => [a] -> a
mconcat [ Builder
acc, String -> Builder
fromString String
"::", Builder
here ]
          Builder
nextAcc <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Builder -> Prefix -> Pretty m Builder
showPrefix (Builder -> Builder
prevPfx forall a b. (a -> b) -> a -> b
$ String -> Builder
fromString String
className) Prefix
tmplPfx
          let inFix :: Builder
inFix = case CtorDtor -> Bool
isDestructor CtorDtor
cd of
                Bool
False -> String -> Builder
fromString String
"::"
                Bool
True -> String -> Builder
fromString String
"::~"
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
nextAcc, Builder
inFix, String -> Builder
fromString String
className ]
        (Prefix
outerPfx : [Prefix]
innerPfxs, UnqualifiedName
_) -> do
          Builder
nextAcc <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Builder -> Prefix -> Pretty m Builder
showPrefix Builder
acc Prefix
outerPfx
          Builder -> [Prefix] -> UnqualifiedName -> StateT Store m Builder
go Builder
nextAcc [Prefix]
innerPfxs UnqualifiedName
uname
        ([], CtorDtorName CtorDtor
_) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM CtorDtorFallthru
CtorDtorFallthru

-- | The CtorDtorFallthru exception is thrown when a Constructor or
-- Destructor is declared without declaring the object type that it is
-- the Constructor or Destructor for.  This indicates either an
-- invalid mangled name or else an internal logic error in prefix
-- evaluation.

data CtorDtorFallthru = CtorDtorFallthru
instance Exception CtorDtorFallthru
instance Show CtorDtorFallthru where
  show :: CtorDtorFallthru -> String
show CtorDtorFallthru
_ = String
"Illegal fallthrough in constructor/destructor case"

isDestructor :: CtorDtor -> Bool
isDestructor :: CtorDtor -> Bool
isDestructor CtorDtor
cd =
  case CtorDtor
cd of
    CtorDtor
D0 -> Bool
True
    CtorDtor
D1 -> Bool
True
    CtorDtor
D2 -> Bool
True
    CtorDtor
_ -> Bool
False

showQualifiers :: Monad m => Builder -> [CVQualifier] -> Pretty m Builder
showQualifiers :: forall (m :: * -> *).
Monad m =>
Builder -> [CVQualifier] -> Pretty m Builder
showQualifiers Builder
qualifies [CVQualifier]
qs =
  case forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CVQualifier]
qs of
    Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    Bool
False -> forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
Monad m =>
(Builder, Builder) -> CVQualifier -> Pretty m (Builder, Builder)
showQualifier (Builder
qualifies,forall a. Monoid a => a
mempty) [CVQualifier]
qs

showQualifier :: Monad m
              => (Builder, Builder) -> CVQualifier
              -> Pretty m (Builder, Builder)
showQualifier :: forall (m :: * -> *).
Monad m =>
(Builder, Builder) -> CVQualifier -> Pretty m (Builder, Builder)
showQualifier (Builder
accum,Builder
res) CVQualifier
q = do
  -- accum is the accumulated name with the base name, used for
  -- recording subtitutions.  res is the accumulated name but not
  -- including the base name which is previously emitted.  res is
  -- ultimately returned.
  let qual :: Builder
qual = case CVQualifier
q of
              CVQualifier
Restrict -> String -> Builder
fromString String
"restrict"
              CVQualifier
Volatile -> String -> Builder
fromString String
"volatile"
              CVQualifier
Const -> String -> Builder
fromString String
"const"
      acc' :: Builder
acc' = forall a. Monoid a => [a] -> a
mconcat [ Builder
accum, Char -> Builder
singleton Char
' ', Builder
qual ]
      res' :: Builder
res' = case Builder
res forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty of
               Bool
True -> Builder
qual
               Bool
False -> forall a. Monoid a => [a] -> a
mconcat [ Builder
res, Char -> Builder
singleton Char
' ', Builder
qual ]
  forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
acc'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Builder
acc', Builder
res')


showPrefixes :: (Monad m, MonadThrow m) => [Prefix] -> Pretty m Builder
showPrefixes :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[Prefix] -> Pretty m Builder
showPrefixes = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Builder -> Prefix -> Pretty m Builder
showPrefix forall a. Monoid a => a
mempty

-- | These are outer namespace/class name qualifiers, so convert them
-- to strings followed by ::
showPrefix :: (Monad m, MonadThrow m) => Builder -> Prefix -> Pretty m Builder
showPrefix :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Builder -> Prefix -> Pretty m Builder
showPrefix Builder
prior Prefix
pfx =
  let addPrior :: Bool -> Builder -> Pretty m Builder
addPrior Bool
doRecord Builder
toThis = do
        let ret :: Builder
ret = case Builder
prior forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty of
                    Bool
False -> forall a. Monoid a => [a] -> a
mconcat [ Builder
prior, String -> Builder
fromString String
"::", Builder
toThis ]
                    Bool
True -> Builder
toThis
        if Bool
doRecord then forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution Builder
ret else forall (m :: * -> *) a. Monad m => a -> m a
return Builder
ret
  in case Prefix
pfx of
       DataMemberPrefix String
s -> forall {m :: * -> *}.
Monad m =>
Bool -> Builder -> Pretty m Builder
addPrior Bool
True forall a b. (a -> b) -> a -> b
$ String -> Builder
fromString String
s
       UnqualifiedPrefix UnqualifiedName
uname -> forall {m :: * -> *}.
Monad m =>
Bool -> Builder -> Pretty m Builder
addPrior Bool
True forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UnqualifiedName -> Pretty m Builder
showUnqualifiedName UnqualifiedName
uname
       SubstitutionPrefix Substitution
s -> forall {m :: * -> *}.
Monad m =>
Bool -> Builder -> Pretty m Builder
addPrior Bool
False forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Substitution -> Pretty m Builder
showSubstitution Substitution
s
       TemplateArgsPrefix [TemplateArg]
args ->
         case Builder
prior forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty of
           Bool
True -> (Builder -> Builder
templateBracket forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
args) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution
           Bool
False -> do forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
prior
                       Builder
targs <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
args
                       let this :: Builder
this = forall a. Monoid a => [a] -> a
mconcat [ Builder
prior, Builder -> Builder
templateBracket Builder
targs ]
                       forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution Builder
this

showUnqualifiedName :: (Monad m, MonadThrow m)
                    => UnqualifiedName -> Pretty m Builder
showUnqualifiedName :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UnqualifiedName -> Pretty m Builder
showUnqualifiedName UnqualifiedName
uname =
  case UnqualifiedName
uname of
    OperatorName Operator
op -> do
      Builder
ob <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Operator -> Pretty m Builder
showOperator Operator
op
      forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Builder
fromString String
"operator" forall a. Monoid a => a -> a -> a
`mappend` Builder
ob)
    CtorDtorName CtorDtor
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM UnqualCtorDtor
UnqualCtorDtor
    SourceName String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Builder
fromString String
s) -- KWQ: add Substitution?  "C" extern func?

-- | The UnqualCtorDtor exception is thrown when a attempting to
-- generate a Constructor or Destructor name for an Unqualified name.
-- Although this is allowed by the specification, in this
-- implementation it represents a logic issue since there is no known
-- object to declare the Constructor or Destructor for.

data UnqualCtorDtor = UnqualCtorDtor
instance Exception UnqualCtorDtor
instance Show UnqualCtorDtor where
  show :: UnqualCtorDtor -> String
show UnqualCtorDtor
_ = String
"showUnqualifiedName shouldn't reach the ctor/dtor case?"

showOperator :: (Monad m, MonadThrow m) => Operator -> Pretty m Builder
showOperator :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Operator -> Pretty m Builder
showOperator Operator
op =
  case Operator
op of
    Operator
OpNew -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" new"
    Operator
OpNewArray -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" new[]"
    Operator
OpDelete -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" delete"
    Operator
OpDeleteArray -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" delete[]"
    Operator
OpUPlus -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'+'
    Operator
OpUMinus -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'-'
    Operator
OpAddressOf -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'&'
    Operator
OpDeref -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'*'
    Operator
OpBitNot -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'~'
    Operator
OpPlus -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'+'
    Operator
OpMinus -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'-'
    Operator
OpMul -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'*'
    Operator
OpDiv -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'/'
    Operator
OpMod -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'%'
    Operator
OpBitAnd -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'&'
    Operator
OpBitOr -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'|'
    Operator
OpBitXor -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'^'
    Operator
OpAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'='
    Operator
OpPlusAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"+="
    Operator
OpMinusAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"-="
    Operator
OpMulAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"*="
    Operator
OpDivAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"/="
    Operator
OpModAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"%="
    Operator
OpAndAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"&="
    Operator
OpOrAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"|="
    Operator
OpXorAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"^="
    Operator
OpShl -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"<<"
    Operator
OpShr -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
">>"
    Operator
OpShlAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"<<="
    Operator
OpShrAssign -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
">>="
    Operator
OpEquals -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"=="
    Operator
OpNotEquals -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"!="
    Operator
OpLt -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'<'
    Operator
OpGt -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'>'
    Operator
OpLte -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"<="
    Operator
OpGte -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
">="
    Operator
OpNot -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'!'
    Operator
OpAnd -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"&&"
    Operator
OpOr -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"||"
    Operator
OpPlusPlus -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"++"
    Operator
OpMinusMinus -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"--"
    Operator
OpComma -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
','
    Operator
OpArrowStar -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"->*"
    Operator
OpArrow -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"->"
    Operator
OpCall -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"()"
    Operator
OpIndex -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"[]"
    Operator
OpQuestion -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'?'
    Operator
OpSizeofType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" sizeof"
    Operator
OpSizeofExpr -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" sizeof"
    Operator
OpAlignofType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" alignof"
    Operator
OpAlignofExpr -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" alignof"
    OpCast CXXType
t -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
' ' forall a. Monoid a => a -> a -> a
`mappend` Builder
tb
    OpVendor Int
n String
oper -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString (String
"vendor" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
oper) -- ??

showType :: (Monad m, MonadThrow m) => CXXType -> Pretty m Builder
showType :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t =
  case CXXType
t of
    QualifiedType [CVQualifier]
qs CXXType
t' -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      Builder
quals <- forall (m :: * -> *).
Monad m =>
Builder -> [CVQualifier] -> Pretty m Builder
showQualifiers Builder
tb [CVQualifier]
qs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
tb, Char -> Builder
singleton Char
' ' ] forall a. Monoid a => a -> a -> a
`mappend` Builder
quals
    PointerToType (FunctionType [CXXType]
ts) -> do
      -- Since we don't explicitly descend the FunctionType here, we
      -- need to create a stub entry in the substitution table for it
      -- (otherwise the pointer to the type will be off by one).  The
      -- stub will never be referenced because function types aren't
      -- first-class
      [Builder]
ts' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType [CXXType]
ts
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
ts'
        then forall (m :: * -> *) a. Monad m => a -> m a
return()
        else forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution'
             forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [ forall a. [a] -> a
head [Builder]
ts'
                       , String -> Builder
fromString String
" ("
                       , forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (String -> Builder
fromString String
", ") forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [Builder]
ts'
                       , Char -> Builder
singleton Char
')'
                       ]
      Builder
r <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[CXXType] -> Pretty m Builder
showFunctionType [CXXType]
ts
      forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution forall a b. (a -> b) -> a -> b
$! Builder
r
    PointerToType CXXType
t' -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
singleton Char
'*'
      forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution forall a b. (a -> b) -> a -> b
$! Builder
r
    ReferenceToType CXXType
t' -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
singleton Char
'&'
      forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution forall a b. (a -> b) -> a -> b
$! Builder
r
    RValueReferenceToType CXXType
t' -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
"&&"
      forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution forall a b. (a -> b) -> a -> b
$! Builder
r
    ComplexPairType CXXType
t' -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
" complex"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
r
    ImaginaryType CXXType
t' -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
" imaginary"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
r
    ParameterPack CXXType
_ -> forall a. HasCallStack => a
undefined
    VendorTypeQualifier String
q CXXType
t' -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
q, Char -> Builder
singleton Char
' ', Builder
tb ]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
r
    CXXType
VoidType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"void"
    CXXType
Wchar_tType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"wchar_t"
    CXXType
BoolType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"bool"
    CXXType
CharType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"char"
    CXXType
SignedCharType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"signed char"
    CXXType
UnsignedCharType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned char"
    CXXType
ShortType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"short"
    CXXType
UnsignedShortType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned short"
    CXXType
IntType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"int"
    CXXType
UnsignedIntType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned int"
    CXXType
LongType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"long"
    CXXType
UnsignedLongType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned long"
    CXXType
LongLongType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"long long"
    CXXType
UnsignedLongLongType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned long long"
    CXXType
Int128Type -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"__int128"
    CXXType
UnsignedInt128Type -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned __int128"
    CXXType
FloatType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"float"
    CXXType
DoubleType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"double"
    CXXType
LongDoubleType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"long double"
    CXXType
Float128Type -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"__float128"
    CXXType
EllipsisType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"..."
    CXXType
Char32Type -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"char32_t"
    CXXType
Char16Type -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"char16_t"
    CXXType
AutoType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"auto"
    CXXType
NullPtrType -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::nullptr_t"
    VendorBuiltinType String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
s
    FunctionType [CXXType]
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM NonPointerFunctionType
NonPointerFunctionType
    ExternCFunctionType [CXXType]
ts -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[CXXType] -> Pretty m Builder
showFunctionType [CXXType]
ts
      let r :: Builder
r = String -> Builder
fromString String
"extern \"C\" " forall a. Monoid a => a -> a -> a
`mappend` Builder
tb
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
r
    ArrayTypeN (Just Int
n) CXXType
t' -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = forall a. Monoid a => [a] -> a
mconcat [ Builder
tb, Char -> Builder
singleton Char
'[', String -> Builder
fromString (forall a. Show a => a -> String
show Int
n), Char -> Builder
singleton Char
']' ]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
r
    ArrayTypeN Maybe Int
Nothing CXXType
t' -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
"[]"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
r
    ClassEnumType Name
n -> do
      Builder
r <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
n
      Builder
q <- forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
r Name
n
      forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [Builder
r, Builder
q]
    PtrToMemberType CXXType
c CXXType
m -> do
      Builder
r <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> CXXType -> Pretty m Builder
showPtrToMember CXXType
c CXXType
m
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Builder
r
    SubstitutionType Substitution
s -> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Substitution -> Pretty m Builder
showSubstitution Substitution
s
    TemplateParamType TemplateParam
tt -> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
TemplateParam -> Pretty m Builder
showTemplateParam TemplateParam
tt

-- | The NonPointerFunctionType exception is thrown when attempting to
-- pretty-print a function type that is not a pointer.  First-class
-- function types are not supported at this time.  This is a logic
-- error in the library?

data NonPointerFunctionType = NonPointerFunctionType
instance Exception NonPointerFunctionType
instance Show NonPointerFunctionType where
    show :: NonPointerFunctionType -> String
show NonPointerFunctionType
_ = String
"Only pointers to function types are supported"

showSubstitution :: (Monad m, MonadThrow m) => Substitution -> Pretty m Builder
showSubstitution :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Substitution -> Pretty m Builder
showSubstitution Substitution
s =
  case Substitution
s of
    Substitution Maybe String
ss -> forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Maybe String -> Pretty m Builder
getSubstitution Maybe String
ss
    Substitution
SubStdNamespace -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std"
    Substitution
SubStdAllocator -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::allocator"
    Substitution
SubBasicString -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::basic_string"
    Substitution
SubBasicStringArgs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::basic_string<char, std::char_traits<char>, std::allocator<char> >"
    Substitution
SubBasicIstream -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::basic_istream<char, std::char_traits<char> >"
    Substitution
SubBasicOstream -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::basic_ostream<char, std::char_traits<char> >"
    Substitution
SubBasicIostream -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::basic_iostream<char, std::char_traits<char> >"

showTemplateParam :: (Monad m, MonadThrow m) => TemplateParam -> Pretty m Builder
showTemplateParam :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
TemplateParam -> Pretty m Builder
showTemplateParam (TemplateParam Maybe String
t) = do Builder
r <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Maybe String -> Pretty m Builder
getTemplateArgument Maybe String
t
                                         forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitutionAlways Builder
r

showPtrToMember :: (Monad m, MonadThrow m)
                => CXXType -> CXXType -> Pretty m Builder
showPtrToMember :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> CXXType -> Pretty m Builder
showPtrToMember (ClassEnumType Name
n) (FunctionType (CXXType
rt:[CXXType]
argts)) = do
  Builder
rt' <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
rt
  [Builder]
argts' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType [CXXType]
argts
  Builder
nb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
n
  Builder
q <- forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
nb Name
n
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
rt', String -> Builder
fromString String
" (", Builder
nb, Builder
q , String -> Builder
fromString String
"::*)("
                    , forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (String -> Builder
fromString String
", ") [Builder]
argts')
                    , Char -> Builder
singleton Char
')'
                    ]
showPtrToMember CXXType
_ CXXType
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BarePtrToMember
BarePtrToMember

-- | The BarePtrToMember exception is thrown when there is not enough
-- information to determine what the pointer should point to.  This is
-- either a bad mangled name or an internal logic error.

data BarePtrToMember = BarePtrToMember
instance Exception BarePtrToMember
instance Show BarePtrToMember where
  show :: BarePtrToMember -> String
show BarePtrToMember
_ = String
"Expected a ClassEnumType and FunctionType pair for PtrToMemberType"

showFunctionType :: (Monad m, MonadThrow m) => [CXXType] -> Pretty m Builder
showFunctionType :: forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[CXXType] -> Pretty m Builder
showFunctionType [CXXType]
ts =
  case [CXXType]
ts of
    [] -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM EmptyFunctionType
EmptyFunctionType
    [CXXType
rtype, CXXType
VoidType] -> do
      Builder
rt' <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
rtype
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
rt', String -> Builder
fromString String
" (*)()" ]
    CXXType
rtype:[CXXType]
rest -> do
      Builder
tb <- forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
rtype
      [Builder]
rbs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType [CXXType]
rest
      let arglist :: Builder
arglist = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (String -> Builder
fromString String
", ") [Builder]
rbs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [ Builder
tb, String -> Builder
fromString String
" (*)(", Builder
arglist, Char -> Builder
singleton Char
')' ]

-- | The EmptyFunctionType exception is thrown when there is no
-- argument specification for the function.  This is either a bad
-- mangled name or an internal logic error.

data EmptyFunctionType = EmptyFunctionType
instance Exception EmptyFunctionType
instance Show EmptyFunctionType where
  show :: EmptyFunctionType -> String
show EmptyFunctionType
_ = String
"Empty type list in function type"

-- Helpers

-- Taken from parsec-numbers
numberValue :: Integral i => Int -> String -> Maybe i
numberValue :: forall i. Integral i => Int -> String -> Maybe i
numberValue Int
base =
  let seqIdToNum :: Int -> Maybe Int
seqIdToNum Int
seqId | Int
seqId forall a. Ord a => a -> a -> Bool
>= Char -> Int
ord Char
'A' Bool -> Bool -> Bool
&& Int
seqId forall a. Ord a => a -> a -> Bool
<= Char -> Int
ord Char
'Z' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
seqId forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' forall a. Num a => a -> a -> a
+ Int
10
                       | Int
seqId forall a. Ord a => a -> a -> Bool
>= Char -> Int
ord Char
'0' Bool -> Bool -> Bool
&& Int
seqId forall a. Ord a => a -> a -> Bool
<= Char -> Int
ord Char
'9' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
seqId forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'
                       | Bool
otherwise = forall a. Maybe a
Nothing
  in
    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ i
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base forall a. Num a => a -> a -> a
* i
x) forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
seqIdToNum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) i
0