{-# 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 HashMap Int Builder
forall a. Monoid a => a
mempty [Maybe Builder]
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 <- StateT Store m 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 Builder -> [Builder] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HashMap Int Builder -> [Builder]
forall k v. HashMap k v -> [v]
HM.elems HashMap Int Builder
s of
    Bool
False -> do
      let n :: Int
n = HashMap Int Builder -> Int
forall k v. HashMap k v -> Int
HM.size HashMap Int Builder
s
      let store' :: Store
store' = Store
store { substitutions = HM.insert n b s }
      Store -> StateT Store m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Store -> StateT Store m ()) -> Store -> StateT Store m ()
forall a b. (a -> b) -> a -> b
$! Store
store'
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
b
    Bool
True -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
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 <- StateT Store m 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 = HashMap Int Builder -> Int
forall k v. HashMap k v -> Int
HM.size HashMap Int Builder
s
  let store' :: Store
store' = Store
store { substitutions = HM.insert n b s }
  Store -> StateT Store m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Store -> StateT Store m ()) -> Store -> StateT Store m ()
forall a b. (a -> b) -> a -> b
$! Store
store'
  Builder -> Pretty m Builder
forall a. a -> StateT Store m a
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' = StateT Store m Builder -> StateT Store m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Store m Builder -> StateT Store m ())
-> (Builder -> StateT Store m Builder)
-> Builder
-> StateT Store m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> StateT Store m Builder
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 = (Store -> Store) -> StateT Store m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Store -> Store) -> StateT Store m ())
-> (Store -> Store) -> StateT Store m ()
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' = Int -> HashMap Int Builder -> HashMap Int Builder
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete ((HashMap Int Builder -> Int
forall k v. HashMap k v -> Int
HM.size HashMap Int Builder
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) HashMap Int Builder
s
  in Store
store { substitutions = 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 <- (Store -> HashMap Int Builder)
-> StateT Store m (HashMap Int Builder)
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 -> Int -> HashMap Int Builder -> Pretty m Builder
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 Int -> String -> Maybe Int
forall i. Integral i => Int -> String -> Maybe i
numberValue Int
36 String
ix of
        Just Int
n -> Int -> HashMap Int Builder -> Pretty m Builder
forall {k} {a}. Hashable k => k -> HashMap k a -> StateT Store m a
lookupError (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) HashMap Int Builder
st
        Maybe Int
Nothing -> Pretty m Builder
forall {a}. StateT Store m a
errMsg
  where
    errMsg :: StateT Store m a
errMsg = MissingSubstitution -> StateT Store m a
forall e a. (HasCallStack, Exception e) => e -> StateT Store m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (MissingSubstitution -> StateT Store m a)
-> MissingSubstitution -> StateT Store m a
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 = StateT Store m a
-> (a -> StateT Store m a) -> Maybe a -> StateT Store m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT Store m a
forall {a}. StateT Store m a
errMsg a -> StateT Store m a
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (k -> HashMap k a -> Maybe a
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
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 <- StateT Store m 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 = [Maybe Builder] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe Builder]
tas
  Store -> StateT Store m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Store -> StateT Store m ()) -> Store -> StateT Store m ()
forall a b. (a -> b) -> a -> b
$! Store
store { templateArgs = templateArgs store <> [ Nothing ] }
  ReservedTemplateArgument -> Pretty m ReservedTemplateArgument
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReservedTemplateArgument -> Pretty m ReservedTemplateArgument)
-> ReservedTemplateArgument -> Pretty m ReservedTemplateArgument
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 <- StateT Store m Store
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let tas :: [Maybe Builder]
tas = Store -> [Maybe Builder]
templateArgs Store
store
  Bool -> StateT Store m () -> StateT Store m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Maybe Builder] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe Builder]
tas) (StateT Store m () -> StateT Store m ())
-> StateT Store m () -> StateT Store m ()
forall a b. (a -> b) -> a -> b
$
    String -> StateT Store m ()
forall a. HasCallStack => String -> a
error String
"INVALID TEMPLATE ARG RESERVATION: CODING ERROR"
  let ([Maybe Builder]
pre,Maybe Builder
_:[Maybe Builder]
post) = Int -> [Maybe Builder] -> ([Maybe Builder], [Maybe Builder])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [Maybe Builder]
tas
  if Builder -> Maybe Builder
forall a. a -> Maybe a
Just Builder
b Maybe Builder -> [Maybe Builder] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Builder]
pre
    then Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
b
    else do let store' :: Store
store' = Store
store { templateArgs = pre <> [ Just b ] <> post }
            Store -> StateT Store m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Store -> StateT Store m ()) -> Store -> StateT Store m ()
forall a b. (a -> b) -> a -> b
$! Store
store'
            Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
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 <- [Maybe Builder] -> [Builder]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Builder] -> [Builder])
-> StateT Store m [Maybe Builder] -> StateT Store m [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Store -> [Maybe Builder]) -> StateT Store m [Maybe Builder]
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 -> Int -> [Builder] -> Pretty m Builder
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 Int -> String -> Maybe Int
forall i. Integral i => Int -> String -> Maybe i
numberValue Int
36 String
ix of
        Just Int
n -> Int -> [Builder] -> Pretty m Builder
forall {a}. Int -> [a] -> StateT Store m a
lookupError (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Builder]
st
        Maybe Int
Nothing -> Pretty m Builder
forall {a}. StateT Store m a
errMsg
  where
    errMsg :: StateT Store m a
errMsg = MissingTemplateArgument -> StateT Store m a
forall e a. (HasCallStack, Exception e) => e -> StateT Store m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (MissingTemplateArgument -> StateT Store m a)
-> MissingTemplateArgument -> StateT Store m a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
m
                      then a -> StateT Store m a
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> StateT Store m a) -> a -> StateT Store m a
forall a b. (a -> b) -> a -> b
$ [a]
m [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
k
                      else StateT Store m a
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
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 (Builder -> Text) -> m Builder -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Store m Builder -> Store -> m Builder
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (DecodedName -> StateT Store m Builder
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 = (Text -> String) -> m Text -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack (m Text -> m String)
-> (DecodedName -> m Text) -> DecodedName -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodedName -> m Text
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 -> Name -> [CXXType] -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> [CXXType] -> Pretty m Builder
showFunction Name
fname [CXXType]
argTypes
    ConstStructData UnqualifiedName
varName -> UnqualifiedName -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UnqualifiedName -> Pretty m Builder
showUnqualifiedName UnqualifiedName
varName
    Data Name
varName -> do Builder
nm <- Name -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
varName
                       Builder
qual <- Builder -> Name -> Pretty m Builder
forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
nm Name
varName
                       Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
nm, Builder
qual]
    VirtualTable CXXType
t -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"vtable for ", Builder
tb ]
    VTTStructure CXXType
t -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
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 <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"typeinfo for ", Builder
tb ]
    TypeInfoName CXXType
t -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
"typeinfo name for ", Builder
tb ]
    GuardVariable Name
vname -> do
      Builder
vn <- Name -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
vname
      Builder
vq <- Builder -> Name -> Pretty m Builder
forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
vn Name
vname
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
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 <- DecodedName -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecodedName -> Pretty m Builder
dispatchTopLevel DecodedName
target
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
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 <- DecodedName -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecodedName -> Pretty m Builder
dispatchTopLevel DecodedName
target
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
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 <- Name -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
fname
        Pretty m ()
forall (m :: * -> *). Monad m => Pretty m ()
dropLastSubstitution
        Builder
retSpec <- if Name -> Bool
hasRetType Name
fname
                   then do Builder
p <- case [CXXType]
args of
                                  [] -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$ String -> Builder
fromString String
"void"
                                  [CXXType]
_ -> CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
retType
                           Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
p, Char -> Builder
singleton Char
' ' ]
                   else Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
forall a. Monoid a => a
mempty
        [Builder]
argBuilders <- case [CXXType]
argTypes of
          [CXXType
VoidType] -> [Builder] -> StateT Store m [Builder]
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Builder]
forall a. Monoid a => a
mempty
          [CXXType]
_ -> (CXXType -> Pretty m Builder)
-> [CXXType] -> StateT Store m [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType [CXXType]
argTypes
        let argSpec :: Builder
argSpec = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
                      ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (String -> Builder
fromString String
", ") [Builder]
argBuilders
        Builder
quals <- Builder -> Name -> Pretty m Builder
forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
forall a. Monoid a => a
mempty Name
fname
        Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
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 = Bool -> ((Text, Char) -> Bool) -> Maybe (Text, Char) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Char
'>' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (Char -> Bool) -> ((Text, Char) -> Char) -> (Text, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Char) -> Char
forall a b. (a, b) -> b
snd) (Maybe (Text, Char) -> Bool)
-> (Builder -> Maybe (Text, Char)) -> Builder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Text, Char)
unsnoc (Text -> Maybe (Text, Char))
-> (Builder -> Text) -> Builder -> Maybe (Text, Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
  in Char -> Builder
singleton Char
'<' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
     if Builder -> Bool
lastIsTemplateClosure Builder
tmpltArgs
     then Builder
tmpltArgs Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
" >"
     else Builder
tmpltArgs Builder -> Builder -> Builder
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 <- [Prefix] -> UnqualifiedName -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[Prefix] -> UnqualifiedName -> Pretty m Builder
showPrefixedName [Prefix]
pfxs UnqualifiedName
uname
      Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution Builder
pn
    UnscopedName UName
uname -> UName -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UName -> Pretty m Builder
showUName UName
uname
    NestedTemplateName [CVQualifier]
_ [Prefix]
pfxs [TemplateArg]
targs -> do
      Builder
p <- [Prefix] -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[Prefix] -> Pretty m Builder
showPrefixes [Prefix]
pfxs
      Builder
t <- Builder -> Builder
templateBracket (Builder -> Builder) -> Pretty m Builder -> Pretty m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TemplateArg] -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
targs
      Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
p Builder
t
    UnscopedTemplateName UName
uname [TemplateArg]
targs -> do
      Builder
un <- UName -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UName -> Pretty m Builder
showUName UName
uname
      Builder -> Pretty m ()
forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
un
      Builder
tns <- [TemplateArg] -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
targs
      Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
un Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder -> Builder
templateBracket Builder
tns
    UnscopedTemplateSubstitution Substitution
s [TemplateArg]
targs -> do
      Builder
ss <- Substitution -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Substitution -> Pretty m Builder
showSubstitution Substitution
s
      Builder
tns <- [TemplateArg] -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
targs
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
ss Builder -> Builder -> Builder
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 -> UnqualifiedName -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UnqualifiedName -> Pretty m Builder
showUnqualifiedName UnqualifiedName
uname
    UStdName UnqualifiedName
uname -> do
      Builder
un <- UnqualifiedName -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UnqualifiedName -> Pretty m Builder
showUnqualifiedName UnqualifiedName
uname
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Builder
fromString String
"std::" Builder -> Builder -> Builder
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
_ ->
    Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
pn, Char -> Builder
singleton Char
' ' ]) (Builder -> Builder) -> Pretty m Builder -> Pretty m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builder -> [CVQualifier] -> Pretty m Builder
forall (m :: * -> *).
Monad m =>
Builder -> [CVQualifier] -> Pretty m Builder
showQualifiers Builder
pn [CVQualifier]
qs
  NestedTemplateName qs :: [CVQualifier]
qs@(CVQualifier
_:[CVQualifier]
_) [Prefix]
_ [TemplateArg]
_ ->
    Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
pn, Char -> Builder
singleton Char
' ' ]) (Builder -> Builder) -> Pretty m Builder -> Pretty m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builder -> [CVQualifier] -> Pretty m Builder
forall (m :: * -> *).
Monad m =>
Builder -> [CVQualifier] -> Pretty m Builder
showQualifiers Builder
pn [CVQualifier]
qs
  Name
_ -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
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 <- (TemplateArg -> Pretty m Builder)
-> [TemplateArg] -> StateT Store m [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TemplateArg -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
TemplateArg -> Pretty m Builder
showTArg [TemplateArg]
targs
  Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$! Builder -> [Builder] -> [Builder]
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 <- Pretty m ReservedTemplateArgument
forall (m :: * -> *). Monad m => Pretty m ReservedTemplateArgument
reserveTemplateArgument
                            Builder
tt <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
                            Pretty m Builder -> StateT Store m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Pretty m Builder -> StateT Store m ())
-> Pretty m Builder -> StateT Store m ()
forall a b. (a -> b) -> a -> b
$ ReservedTemplateArgument -> Builder -> Pretty m Builder
forall (m :: * -> *).
Monad m =>
ReservedTemplateArgument -> Builder -> Pretty m Builder
recordTemplateArgument ReservedTemplateArgument
tnum Builder
tt
                            Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
tt
    ExprPrimaryTemplateArg ExprPrimary
ep -> ExprPrimary -> Pretty m Builder
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 <- CXXType -> StateT Store m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
ty
                            Builder -> StateT Store m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> StateT Store m Builder)
-> Builder -> StateT Store m Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"false"
          | Int
intval Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"true"
        CXXType
_ -> do Builder
sty <- CXXType -> Pretty m Builder
forall {m :: * -> *}.
MonadThrow m =>
CXXType -> StateT Store m Builder
parenShowType CXXType
ty
                Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
sty
                                  , String -> Builder
fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> String
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 = Builder -> [Prefix] -> UnqualifiedName -> StateT Store m Builder
forall {m :: * -> *}.
MonadThrow m =>
Builder -> [Prefix] -> UnqualifiedName -> StateT Store m Builder
go Builder
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
          Builder -> StateT Store m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution (Builder -> StateT Store m Builder)
-> Builder -> StateT Store m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
acc, String -> Builder
fromString String
"::", String -> Builder
fromString String
n ]
        ([], OperatorName Operator
op) -> do
          Builder
ob <- Operator -> StateT Store m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Operator -> Pretty m Builder
showOperator Operator
op
          Builder -> Pretty m ()
forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
ob
          case Builder
acc Builder -> Builder -> Bool
forall a. Eq a => a -> a -> Bool
== Builder
forall a. Monoid a => a
mempty of
            Bool
False -> Builder -> StateT Store m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> StateT Store m Builder)
-> Builder -> StateT Store m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
acc, String -> Builder
fromString String
"::operator", Builder
ob ]
            Bool
True -> Builder -> StateT Store m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> StateT Store m Builder)
-> Builder -> StateT Store m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
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 Builder -> Builder -> Bool
forall a. Eq a => a -> a -> Bool
== Builder
forall a. Monoid a => a
mempty of
                  Bool
False -> Builder
acc Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
"::"
                  Bool
True -> Builder
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 Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
className
          Builder -> Pretty m ()
forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
sub
          Builder -> StateT Store m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> StateT Store m Builder)
-> Builder -> StateT Store m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
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 Builder -> Builder -> Bool
forall a. Eq a => a -> a -> Bool
== Builder
forall a. Monoid a => a
mempty of
                               Bool
True -> Builder
here
                               Bool
False -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
acc, String -> Builder
fromString String
"::", Builder
here ]
          Builder
nextAcc <- Builder -> Prefix -> StateT Store m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Builder -> Prefix -> Pretty m Builder
showPrefix (Builder -> Builder
prevPfx (Builder -> Builder) -> Builder -> Builder
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
"::~"
          Builder -> StateT Store m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> StateT Store m Builder)
-> Builder -> StateT Store m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
nextAcc, Builder
inFix, String -> Builder
fromString String
className ]
        (Prefix
outerPfx : [Prefix]
innerPfxs, UnqualifiedName
_) -> do
          Builder
nextAcc <- Builder -> Prefix -> StateT Store m Builder
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
_) -> CtorDtorFallthru -> StateT Store m Builder
forall e a. (HasCallStack, Exception e) => e -> StateT Store m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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 [CVQualifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CVQualifier]
qs of
    Bool
True -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
forall a. Monoid a => a
mempty
    Bool
False -> (Builder, Builder) -> Builder
forall a b. (a, b) -> b
snd ((Builder, Builder) -> Builder)
-> StateT Store m (Builder, Builder) -> Pretty m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Builder, Builder)
 -> CVQualifier -> StateT Store m (Builder, Builder))
-> (Builder, Builder)
-> [CVQualifier]
-> StateT Store m (Builder, Builder)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Builder, Builder)
-> CVQualifier -> StateT Store m (Builder, Builder)
forall (m :: * -> *).
Monad m =>
(Builder, Builder) -> CVQualifier -> Pretty m (Builder, Builder)
showQualifier (Builder
qualifies,Builder
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' = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
accum, Char -> Builder
singleton Char
' ', Builder
qual ]
      res' :: Builder
res' = case Builder
res Builder -> Builder -> Bool
forall a. Eq a => a -> a -> Bool
== Builder
forall a. Monoid a => a
mempty of
               Bool
True -> Builder
qual
               Bool
False -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
res, Char -> Builder
singleton Char
' ', Builder
qual ]
  Builder -> Pretty m ()
forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
acc'
  (Builder, Builder) -> Pretty m (Builder, Builder)
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Builder, Builder) -> Pretty m (Builder, Builder))
-> (Builder, Builder) -> Pretty m (Builder, Builder)
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 = (Builder -> Prefix -> StateT Store m Builder)
-> Builder -> [Prefix] -> StateT Store m Builder
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Builder -> Prefix -> StateT Store m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Builder -> Prefix -> Pretty m Builder
showPrefix Builder
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 Builder -> Builder -> Bool
forall a. Eq a => a -> a -> Bool
== Builder
forall a. Monoid a => a
mempty of
                    Bool
False -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
prior, String -> Builder
fromString String
"::", Builder
toThis ]
                    Bool
True -> Builder
toThis
        if Bool
doRecord then Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution Builder
ret else Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
ret
  in case Prefix
pfx of
       DataMemberPrefix String
s -> Bool -> Builder -> Pretty m Builder
forall {m :: * -> *}.
Monad m =>
Bool -> Builder -> Pretty m Builder
addPrior Bool
True (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$ String -> Builder
fromString String
s
       UnqualifiedPrefix UnqualifiedName
uname -> Bool -> Builder -> Pretty m Builder
forall {m :: * -> *}.
Monad m =>
Bool -> Builder -> Pretty m Builder
addPrior Bool
True (Builder -> Pretty m Builder)
-> Pretty m Builder -> Pretty m Builder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UnqualifiedName -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
UnqualifiedName -> Pretty m Builder
showUnqualifiedName UnqualifiedName
uname
       SubstitutionPrefix Substitution
s -> Bool -> Builder -> Pretty m Builder
forall {m :: * -> *}.
Monad m =>
Bool -> Builder -> Pretty m Builder
addPrior Bool
False (Builder -> Pretty m Builder)
-> Pretty m Builder -> Pretty m Builder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Substitution -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Substitution -> Pretty m Builder
showSubstitution Substitution
s
       TemplateArgsPrefix [TemplateArg]
args ->
         case Builder
prior Builder -> Builder -> Bool
forall a. Eq a => a -> a -> Bool
== Builder
forall a. Monoid a => a
mempty of
           Bool
True -> (Builder -> Builder
templateBracket (Builder -> Builder) -> Pretty m Builder -> Pretty m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TemplateArg] -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
args) Pretty m Builder
-> (Builder -> Pretty m Builder) -> Pretty m Builder
forall a b.
StateT Store m a -> (a -> StateT Store m b) -> StateT Store m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution
           Bool
False -> do Builder -> Pretty m ()
forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution' Builder
prior
                       Builder
targs <- [TemplateArg] -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[TemplateArg] -> Pretty m Builder
showTArgs [TemplateArg]
args
                       let this :: Builder
this = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
prior, Builder -> Builder
templateBracket Builder
targs ]
                       Builder -> Pretty m Builder
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 <- Operator -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Operator -> Pretty m Builder
showOperator Operator
op
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Builder
fromString String
"operator" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
ob)
    CtorDtorName CtorDtor
_ -> UnqualCtorDtor -> Pretty m Builder
forall e a. (HasCallStack, Exception e) => e -> StateT Store m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM UnqualCtorDtor
UnqualCtorDtor
    SourceName String
s -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
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 -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" new"
    Operator
OpNewArray -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" new[]"
    Operator
OpDelete -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" delete"
    Operator
OpDeleteArray -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" delete[]"
    Operator
OpUPlus -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'+'
    Operator
OpUMinus -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'-'
    Operator
OpAddressOf -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'&'
    Operator
OpDeref -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'*'
    Operator
OpBitNot -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'~'
    Operator
OpPlus -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'+'
    Operator
OpMinus -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'-'
    Operator
OpMul -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'*'
    Operator
OpDiv -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'/'
    Operator
OpMod -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'%'
    Operator
OpBitAnd -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'&'
    Operator
OpBitOr -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'|'
    Operator
OpBitXor -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'^'
    Operator
OpAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'='
    Operator
OpPlusAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"+="
    Operator
OpMinusAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"-="
    Operator
OpMulAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"*="
    Operator
OpDivAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"/="
    Operator
OpModAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"%="
    Operator
OpAndAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"&="
    Operator
OpOrAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"|="
    Operator
OpXorAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"^="
    Operator
OpShl -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"<<"
    Operator
OpShr -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
">>"
    Operator
OpShlAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"<<="
    Operator
OpShrAssign -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
">>="
    Operator
OpEquals -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"=="
    Operator
OpNotEquals -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"!="
    Operator
OpLt -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'<'
    Operator
OpGt -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'>'
    Operator
OpLte -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"<="
    Operator
OpGte -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
">="
    Operator
OpNot -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'!'
    Operator
OpAnd -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"&&"
    Operator
OpOr -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"||"
    Operator
OpPlusPlus -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"++"
    Operator
OpMinusMinus -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"--"
    Operator
OpComma -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
','
    Operator
OpArrowStar -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"->*"
    Operator
OpArrow -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"->"
    Operator
OpCall -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"()"
    Operator
OpIndex -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"[]"
    Operator
OpQuestion -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
'?'
    Operator
OpSizeofType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" sizeof"
    Operator
OpSizeofExpr -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" sizeof"
    Operator
OpAlignofType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" alignof"
    Operator
OpAlignofExpr -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
" alignof"
    OpCast CXXType
t -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Char -> Builder
singleton Char
' ' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
tb
    OpVendor Int
n String
oper -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString (String
"vendor" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
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 <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      Builder
quals <- Builder -> [CVQualifier] -> Pretty m Builder
forall (m :: * -> *).
Monad m =>
Builder -> [CVQualifier] -> Pretty m Builder
showQualifiers Builder
tb [CVQualifier]
qs
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
tb, Char -> Builder
singleton Char
' ' ] Builder -> Builder -> Builder
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' <- (CXXType -> Pretty m Builder)
-> [CXXType] -> StateT Store m [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType [CXXType]
ts
      case [Builder]
ts' of
        [] ->
          () -> StateT Store m ()
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return()
        Builder
ty:[Builder]
tys ->
          Builder -> StateT Store m ()
forall (m :: * -> *). Monad m => Builder -> Pretty m ()
recordSubstitution'
          (Builder -> StateT Store m ()) -> Builder -> StateT Store m ()
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
ty
                    , String -> Builder
fromString String
" ("
                    , [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (String -> Builder
fromString String
", ") [Builder]
tys
                    , Char -> Builder
singleton Char
')'
                    ]
      Builder
r <- [CXXType] -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[CXXType] -> Pretty m Builder
showFunctionType [CXXType]
ts
      Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    PointerToType CXXType
t' -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
singleton Char
'*'
      Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    ReferenceToType CXXType
t' -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
singleton Char
'&'
      Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    RValueReferenceToType CXXType
t' -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
"&&"
      Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    ComplexPairType CXXType
t' -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
" complex"
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    ImaginaryType CXXType
t' -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
" imaginary"
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    ParameterPack CXXType
_ -> Pretty m Builder
forall a. HasCallStack => a
undefined
    VendorTypeQualifier String
q CXXType
t' -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ String -> Builder
fromString String
q, Char -> Builder
singleton Char
' ', Builder
tb ]
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    CXXType
VoidType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"void"
    CXXType
Wchar_tType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"wchar_t"
    CXXType
BoolType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"bool"
    CXXType
CharType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"char"
    CXXType
SignedCharType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"signed char"
    CXXType
UnsignedCharType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned char"
    CXXType
ShortType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"short"
    CXXType
UnsignedShortType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned short"
    CXXType
IntType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"int"
    CXXType
UnsignedIntType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned int"
    CXXType
LongType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"long"
    CXXType
UnsignedLongType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned long"
    CXXType
LongLongType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"long long"
    CXXType
UnsignedLongLongType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned long long"
    CXXType
Int128Type -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"__int128"
    CXXType
UnsignedInt128Type -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"unsigned __int128"
    CXXType
FloatType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"float"
    CXXType
DoubleType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"double"
    CXXType
LongDoubleType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"long double"
    CXXType
Float128Type -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"__float128"
    CXXType
EllipsisType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"..."
    CXXType
Char32Type -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"char32_t"
    CXXType
Char16Type -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"char16_t"
    CXXType
AutoType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"auto"
    CXXType
NullPtrType -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::nullptr_t"
    VendorBuiltinType String
s -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
s
    FunctionType [CXXType]
_ -> NonPointerFunctionType -> Pretty m Builder
forall e a. (HasCallStack, Exception e) => e -> StateT Store m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM NonPointerFunctionType
NonPointerFunctionType
    ExternCFunctionType [CXXType]
ts -> do
      Builder
tb <- [CXXType] -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
[CXXType] -> Pretty m Builder
showFunctionType [CXXType]
ts
      let r :: Builder
r = String -> Builder
fromString String
"extern \"C\" " Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
tb
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    ArrayTypeN (Just Int
n) CXXType
t' -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
tb, Char -> Builder
singleton Char
'[', String -> Builder
fromString (Int -> String
forall a. Show a => a -> String
show Int
n), Char -> Builder
singleton Char
']' ]
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    ArrayTypeN Maybe Int
Nothing CXXType
t' -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
t'
      let r :: Builder
r = Builder
tb Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
fromString String
"[]"
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    ClassEnumType Name
n -> do
      Builder
r <- Name -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
n
      Builder
q <- Builder -> Name -> Pretty m Builder
forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
r Name
n
      Builder -> Pretty m Builder
forall (m :: * -> *). Monad m => Builder -> Pretty m Builder
recordSubstitution (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
r, Builder
q]
    PtrToMemberType CXXType
c CXXType
m -> do
      Builder
r <- CXXType -> CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> CXXType -> Pretty m Builder
showPtrToMember CXXType
c CXXType
m
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! Builder
r
    SubstitutionType Substitution
s -> Substitution -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Substitution -> Pretty m Builder
showSubstitution Substitution
s
    TemplateParamType TemplateParam
tt -> TemplateParam -> Pretty m Builder
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 -> Maybe String -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Maybe String -> Pretty m Builder
getSubstitution Maybe String
ss
    Substitution
SubStdNamespace -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std"
    Substitution
SubStdAllocator -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::allocator"
    Substitution
SubBasicString -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::basic_string"
    Substitution
SubBasicStringArgs -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::basic_string<char, std::char_traits<char>, std::allocator<char> >"
    Substitution
SubBasicIstream -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::basic_istream<char, std::char_traits<char> >"
    Substitution
SubBasicOstream -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! String -> Builder
fromString String
"std::basic_ostream<char, std::char_traits<char> >"
    Substitution
SubBasicIostream -> Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
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 <- Maybe String -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Maybe String -> Pretty m Builder
getTemplateArgument Maybe String
t
                                         Builder -> Pretty m Builder
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' <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
rt
  [Builder]
argts' <- (CXXType -> Pretty m Builder)
-> [CXXType] -> StateT Store m [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType [CXXType]
argts
  Builder
nb <- Name -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
Name -> Pretty m Builder
showName Name
n
  Builder
q <- Builder -> Name -> Pretty m Builder
forall (m :: * -> *).
Monad m =>
Builder -> Name -> Pretty m Builder
showNameQualifiers Builder
nb Name
n
  Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
rt', String -> Builder
fromString String
" (", Builder
nb, Builder
q , String -> Builder
fromString String
"::*)("
                    , [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (String -> Builder
fromString String
", ") [Builder]
argts')
                    , Char -> Builder
singleton Char
')'
                    ]
showPtrToMember CXXType
_ CXXType
_ = BarePtrToMember -> Pretty m Builder
forall e a. (HasCallStack, Exception e) => e -> StateT Store m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, 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
    [] -> EmptyFunctionType -> Pretty m Builder
forall e a. (HasCallStack, Exception e) => e -> StateT Store m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM EmptyFunctionType
EmptyFunctionType
    [CXXType
rtype, CXXType
VoidType] -> do
      Builder
rt' <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
rtype
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
rt', String -> Builder
fromString String
" (*)()" ]
    CXXType
rtype:[CXXType]
rest -> do
      Builder
tb <- CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType CXXType
rtype
      [Builder]
rbs <- (CXXType -> Pretty m Builder)
-> [CXXType] -> StateT Store m [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CXXType -> Pretty m Builder
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
CXXType -> Pretty m Builder
showType [CXXType]
rest
      let arglist :: Builder
arglist = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (String -> Builder
fromString String
", ") [Builder]
rbs
      Builder -> Pretty m Builder
forall a. a -> StateT Store m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Pretty m Builder) -> Builder -> Pretty m Builder
forall a b. (a -> b) -> a -> b
$! [Builder] -> Builder
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Int
ord Char
'A' Bool -> Bool -> Bool
&& Int
seqId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Int
ord Char
'Z' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
seqId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
                       | Int
seqId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Int
ord Char
'0' Bool -> Bool -> Bool
&& Int
seqId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Int
ord Char
'9' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
seqId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'
                       | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
  in
    (i -> Char -> Maybe i) -> i -> String -> Maybe i
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ i
x -> (Int -> i) -> Maybe Int -> Maybe i
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base i -> i -> i
forall a. Num a => a -> a -> a
* i
x) i -> i -> i
forall a. Num a => a -> a -> a
+) (i -> i) -> (Int -> i) -> Int -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Maybe Int -> Maybe i) -> (Char -> Maybe Int) -> Char -> Maybe i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
seqIdToNum (Int -> Maybe Int) -> (Char -> Int) -> Char -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) i
0