itanium-abi 0.1.1.1 → 0.1.2
raw patch · 6 files changed
+586/−160 lines, 6 filesdep +exceptionsdep ~textPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: exceptions
Dependency ranges changed: text
API changes (from Hackage documentation)
+ ABI.Itanium: ConstStructData :: UnqualifiedName -> DecodedName
- ABI.Itanium: cxxNameToString :: DecodedName -> String
+ ABI.Itanium: cxxNameToString :: (Monad m, MonadThrow m) => DecodedName -> m String
- ABI.Itanium: cxxNameToText :: DecodedName -> Text
+ ABI.Itanium: cxxNameToText :: (Monad m, MonadThrow m) => DecodedName -> m Text
Files
- itanium-abi.cabal +4/−3
- src/ABI/Itanium.hs +31/−5
- src/ABI/Itanium/Pretty.hs +480/−148
- src/ABI/Itanium/Types.hs +38/−2
- tests/DemangleTests.hs +4/−2
- tests/test-cases.txt +29/−0
itanium-abi.cabal view
@@ -2,12 +2,12 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: itanium-abi-version: 0.1.1.1+version: 0.1.2 synopsis: An implementation of name mangling/demangling for the Itanium ABI license: BSD3 license-file: LICENSE author: Tristan Ravitch-maintainer: tristan@nochair.net+maintainer: tristan@ravit.ch category: Development build-type: Simple cabal-version: >=1.10@@ -24,7 +24,8 @@ ghc-options: -Wall build-depends: base >= 4 && < 5, boomerang >= 1.4.5.6 && < 1.5,- text >= 0.11 && < 2,+ exceptions >= 0.10 && < 0.11,+ text >= 0.11 && < 2.1, transformers, unordered-containers >= 0.2.3.0 && < 0.3 exposed-modules: ABI.Itanium
src/ABI/Itanium.hs view
@@ -27,6 +27,7 @@ import Prelude hiding ( (.) ) import Control.Category ( (.) )+import Data.Char import Text.Boomerang import Text.Boomerang.String import Text.Boomerang.TH@@ -47,6 +48,7 @@ $(makeBoomerangs ''UName) $(makeBoomerangs ''TemplateArg) $(makeBoomerangs ''TemplateParam)+$(makeBoomerangs ''ExprPrimary) -- | Demangle a name into a structured representation (or an error -- string)@@ -72,6 +74,12 @@ rGuardVariable . lit "GV" . name <> rOverrideThunk . lit "T" . callOffset . topLevelEntity <> rOverrideThunkCovariant . lit "Tc" . callOffset . callOffset . topLevelEntity <>+ rConstStructData . lit "L" . unqualifiedName <>++ -- The following is a "static" function definition, but c++filt+ -- doesn't reproduce the "static" part.+ rFunction . lit "L" . name . bareFunctionType <>+ rFunction . name . bareFunctionType <> rData . name )@@ -123,8 +131,11 @@ rFunctionType . lit "F" . bareFunctionType . lit "E" <> rArrayTypeN . lit "A" . rMaybe int . lit "_" . cxxType <> rPtrToMemberType . lit "M" . cxxType . cxxType <>+ rSubstitutionType . substitution <>- rClassEnumType . name+ rClassEnumType . name <>+ rTemplateParamType . templateParam+ -- Still need: array-type (E), decltype ) @@ -217,6 +228,7 @@ prefix = ( rDataMemberPrefix . sourceName . lit "M" <> rUnqualifiedPrefix . unqualifiedName <> rSubstitutionPrefix . substitution <>+ rSubstitutionPrefix . rSubStdNamespace . lit "St" <> rTemplateParamPrefix . templateParam <> rTemplateArgsPrefix . templateArgs )@@ -230,8 +242,9 @@ ) substitution :: Boomerang StringError String a (Substitution :- a)-substitution = ( rSubstitution . lit "S" . rMaybe (rList1 (satisfy (/='_'))) . lit "_" <>- rSubStdNamespace . lit "St" <>+substitution = (+ rSubstitution . lit "S" . rMaybe seq_id . lit "_" <>+ -- rSubStdNamespace . lit "St" <> -- this one is not standalone, but must be a prefix rSubStdAllocator . lit "Sa" <> rSubBasicString . lit "Sb" <> rSubBasicStringArgs . lit "Ss" <>@@ -240,6 +253,13 @@ rSubBasicIostream . lit "Sd" ) +-- | Reads the sequence ID of a Substitution parameter or Template+-- Argument parameter+seq_id :: Boomerang StringError String a ([Char] :- a)+seq_id = rList1 (satisfy (\c -> and [ c /= '_'+ , (isAsciiUpper c || isDigit c)+ ]))+ unscopedName :: Boomerang StringError String a (UName :- a) unscopedName = ( rUStdName . lit "St" . unqualifiedName <> rUName . unqualifiedName@@ -249,10 +269,16 @@ templateArgs = lit "I" . rList1 templateArg . lit "E" templateArg :: Boomerang StringError String a (TemplateArg :- a)-templateArg = rTypeTemplateArg . cxxType+templateArg = (rTypeTemplateArg . cxxType <>+ lit "L" . rExprPrimaryTemplateArg . exprPrimary . lit "E"+ ) +exprPrimary :: Boomerang (ParserError MajorMinorPos) String a (ExprPrimary :- a)+exprPrimary = (rExprIntLit . cxxType . abiInt )++ templateParam :: Boomerang StringError String a (TemplateParam :- a)-templateParam = ( rTemplateParam . lit "T" . rMaybe int . lit "_" )+templateParam = ( rTemplateParam . lit "T" . rMaybe seq_id . lit "_" ) -- | Parse a length-prefixed string (does not handle newlines) sourceName :: Boomerang (ParserError MajorMinorPos) String a (String :- a)
src/ABI/Itanium/Pretty.hs view
@@ -1,77 +1,257 @@+{-# LANGUAGE LambdaCase #-}+ module ABI.Itanium.Pretty ( cxxNameToString,- cxxNameToText+ 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 ( digitToInt )-import Data.List ( foldl', intersperse )+import Data.Char ( ord )+import Data.List ( intersperse ) import Data.HashMap.Strict ( HashMap ) import qualified Data.HashMap.Strict as HM-import Data.Maybe ( fromMaybe )-import Data.Monoid-import Data.Text.Lazy ( Text, unpack )+import Data.Maybe ( catMaybes )+import Data.Text.Lazy ( Text, unpack, unsnoc ) import Data.Text.Lazy.Builder import ABI.Itanium.Types -type Pretty = State (HashMap Int Builder) --- Only record substitutions that were not previously seen-recordSubstitution :: Builder -> Pretty ()+-- | 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 { substitutions :: HashMap Int Builder+ , templateArgs :: [Maybe Builder]+ }++emptyStore :: Store+emptyStore = Store mempty 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 b = do- s <- get+ store <- get+ let s = substitutions store case b `elem` HM.elems s of False -> do let n = HM.size s- put $! HM.insert n b s- True -> return ()+ let store' = store { substitutions = HM.insert n b s }+ put $! store'+ return b+ True -> return b -getSubstitution :: Maybe String -> Pretty Builder+-- | 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 b = do+ store <- get+ let s = substitutions store+ let n = HM.size s+ let store' = store { substitutions = HM.insert n b s }+ put $! store'+ return 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' = void . 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 = modify $ \store ->+ let s = substitutions store+ s' = HM.delete ((HM.size s) - 1) s+ in 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 s = do- st <- get+ st <- gets substitutions case s of- Nothing -> return $! lookupError 0 st+ Nothing -> lookupError 0 st -- This case always adds 1 from the number because the -- Nothing case is index zero Just ix ->- let n = numberValue 36 ix- in return $! lookupError (n+1) st+ -- seq ID is base 36+ case numberValue 36 ix of+ Just n -> lookupError (n+1) st+ Nothing -> errMsg where- errMsg = error ("No substitution found for " ++ show s)- lookupError k m = fromMaybe errMsg (HM.lookup k m)+ errMsg = throwM $ MissingSubstitution s+ lookupError k m = maybe errMsg return (HM.lookup k m) -cxxNameToText :: DecodedName -> Text-cxxNameToText n = toLazyText $ evalState (dispatchTopLevel n) mempty+-- | 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. -cxxNameToString :: DecodedName -> String-cxxNameToString = unpack . cxxNameToText+data MissingSubstitution = MissingSubstitution (Maybe String)+instance Exception MissingSubstitution+instance Show MissingSubstitution where+ show (MissingSubstitution s) = "No substitution found for " ++ show s -dispatchTopLevel :: DecodedName -> Pretty Builder+++----------------------------------------------------------------------+-- * 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 = do+ store <- get+ let tas = templateArgs store+ nta = length tas+ put $! store { templateArgs = templateArgs store <> [ Nothing ] }+ return $! RTA 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 (RTA i) b = do+ store <- get+ let tas = templateArgs store+ unless (i < length tas) $+ error "INVALID TEMPLATE ARG RESERVATION: CODING ERROR"+ let (pre,_:post) = splitAt i tas+ if Just b `elem` pre+ then return $! b+ else do let store' = store { templateArgs = pre <> [ Just b ] <> post }+ put $! store'+ return $! 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 s = do+ st <- catMaybes <$> gets templateArgs+ case s of+ Nothing -> lookupError 0 st+ -- This case always adds 1 from the number because the+ -- Nothing case is index zero+ Just ix ->+ -- seq ID is base 36+ case numberValue 36 ix of+ Just n -> lookupError (n+1) st+ Nothing -> errMsg+ where+ errMsg = throwM $ MissingTemplateArgument s+ lookupError k m = if k < length m+ then return $ m !! k+ else 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 s) = "No template argument found for " ++ show 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 n = toLazyText <$> evalStateT (dispatchTopLevel n) 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 = fmap unpack . cxxNameToText++dispatchTopLevel :: (Monad m, MonadThrow m) => DecodedName -> Pretty m Builder dispatchTopLevel n = case n of- Function (NestedName qs@(_:_) pfxs uname) argTypes -> do- pn <- showPrefixedName pfxs uname- argBuilders <- case argTypes of- [VoidType] -> return mempty- _ -> mapM showType argTypes- return $! mconcat [ pn- , singleton '('- , mconcat $ intersperse (fromString ", ") argBuilders- , fromString ") "- , showQualifiers qs- ]- Function fname argTypes -> do- nameBuilder <- showName fname- argBuilders <- case argTypes of- [VoidType] -> return mempty- _ -> mapM showType argTypes- return $! mconcat [ nameBuilder- , singleton '('- , mconcat $ intersperse (fromString ", ") argBuilders- , singleton ')'- ]- Data varName -> showName varName+ Function fname argTypes -> showFunction fname argTypes+ ConstStructData varName -> showUnqualifiedName varName+ Data varName -> do nm <- showName varName+ qual <- showNameQualifiers nm varName+ return $! mconcat [nm, qual] VirtualTable t -> do tb <- showType t return $! mconcat [ fromString "vtable for ", tb ]@@ -86,7 +266,8 @@ return $! mconcat [ fromString "typeinfo name for ", tb ] GuardVariable vname -> do vn <- showName vname- return $! mconcat [ fromString "guard variable for ", vn ]+ vq <- showNameQualifiers vn vname+ return $! mconcat [ fromString "guard variable for ", vn, vq ] OverrideThunk _ target -> do tn <- dispatchTopLevel target return $! mconcat [ fromString "non-virtual thunk to ", tn ]@@ -94,34 +275,86 @@ tn <- dispatchTopLevel target return $! mconcat [ fromString "virtual thunk to ", tn ] -showName :: Name -> Pretty Builder+-- | 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 fname args =+ let (retType:retArgTypes) = args+ argTypes = if hasRetType fname then retArgTypes else args+ in do nameBuilder <- showName fname+ dropLastSubstitution+ retSpec <- if hasRetType fname+ then do p <- case args of+ [] -> return $ fromString "void"+ _ -> showType retType+ return $! mconcat [ p, singleton ' ' ]+ else return $! mempty+ argBuilders <- case argTypes of+ [VoidType] -> return mempty+ _ -> mapM showType argTypes+ let argSpec = mconcat+ $ intersperse (fromString ", ") argBuilders+ quals <- showNameQualifiers mempty fname+ return $! mconcat [ retSpec+ , nameBuilder+ , singleton '(' , argSpec , singleton ')'+ , quals+ ]++hasRetType :: Name -> Bool+hasRetType = \case+ NestedTemplateName {} -> True+ UnscopedTemplateName{} -> True+ _ -> 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 tmpltArgs =+ let lastIsTemplateClosure = maybe False (('>' ==) . snd) . unsnoc . toLazyText+ in singleton '<' `mappend`+ if lastIsTemplateClosure tmpltArgs+ then tmpltArgs `mappend` fromString " >"+ else tmpltArgs `mappend` singleton '>'++showName :: (Monad m, MonadThrow m) => Name -> Pretty m Builder showName n = case n of- NestedName qs pfxs uname -> do+ NestedName _ pfxs uname -> do pn <- showPrefixedName pfxs uname- case null qs of- False -> return $! mconcat [ pn, singleton ' ', showQualifiers qs ]- True -> return $! pn+ recordSubstitution pn UnscopedName uname -> showUName uname- NestedTemplateName [] pfxs targs ->- showPrefixedTArgs pfxs targs- NestedTemplateName qs pfxs targs -> do- pn <- showPrefixedTArgs pfxs targs- return $! mconcat [ pn, singleton ' ', showQualifiers qs ]+ NestedTemplateName _ pfxs targs -> do+ p <- showPrefixes pfxs+ t <- templateBracket <$> showTArgs targs+ recordSubstitution $! mappend p t UnscopedTemplateName uname targs -> do un <- showUName uname- recordSubstitution un+ recordSubstitution' un tns <- showTArgs targs- return $! mconcat [ un, singleton '<'- , tns- , singleton '>'- ]+ recordSubstitution $! un `mappend` templateBracket tns UnscopedTemplateSubstitution s targs -> do ss <- showSubstitution s tns <- showTArgs targs- return $! mconcat [ ss, singleton '<', tns, singleton '>' ]+ return $! ss `mappend` templateBracket tns -showUName :: UName -> Pretty Builder+showUName :: (Monad m, MonadThrow m) => UName -> Pretty m Builder showUName u = case u of UName uname -> showUnqualifiedName uname@@ -129,45 +362,56 @@ un <- showUnqualifiedName uname return (fromString "std::" `mappend` un) -showTArgs :: [TemplateArg] -> Pretty Builder+showNameQualifiers :: (Monad m)+ => Builder -> Name -> Pretty m Builder+showNameQualifiers pn = \case+ NestedName qs@(_:_) _ _ ->+ mappend (mconcat [ pn, singleton ' ' ]) <$> showQualifiers pn qs+ NestedTemplateName qs@(_:_) _ _ ->+ mappend (mconcat [ pn, singleton ' ' ]) <$> showQualifiers pn qs+ _ -> return mempty++showTArgs :: (Monad m, MonadThrow m) => [TemplateArg] -> Pretty m Builder showTArgs targs = do tns <- mapM showTArg targs return $! mconcat $! intersperse (fromString ", ") tns -showPrefixedTArgs :: [Prefix] -> [TemplateArg] -> Pretty Builder-showPrefixedTArgs = go mempty- where- go acc pfxs targs =- case pfxs of- [] -> do- tns <- mapM showTArg targs- return $! mconcat [ acc, singleton '<'- , mconcat $ intersperse (fromString ", ") tns- , singleton '>' ]- pfx : rest -> do- px <- showPrefix pfx- let nextAcc = case acc == mempty of- False -> mconcat [ acc, fromString "::", px ]- True -> px- recordSubstitution nextAcc- go nextAcc rest targs--showTArg :: TemplateArg -> Pretty Builder+showTArg :: (Monad m, MonadThrow m) => TemplateArg -> Pretty m Builder showTArg ta = case ta of- TypeTemplateArg t -> showType t+ TypeTemplateArg t -> do tnum <- reserveTemplateArgument+ tt <- showType t+ void $ recordTemplateArgument tnum tt+ return tt+ ExprPrimaryTemplateArg ep -> showExprPrimary ep +showExprPrimary :: (Monad m, MonadThrow m) => ExprPrimary -> Pretty m Builder+showExprPrimary =+ let parenShowType ty = do sty <- showType ty+ return $ mconcat [singleton '(', sty, singleton ')']+ in \case+ ExprIntLit ty intval ->+ case ty of+ BoolType+ | intval == 0 -> return $! fromString "false"+ | intval == 1 -> return $! fromString "true"+ _ -> do sty <- parenShowType ty+ return $! mconcat [ sty+ , fromString $ show intval ]+ -- pass the current prefix builder down so that it can be added to and -- stored for substitutions-showPrefixedName :: [Prefix] -> UnqualifiedName -> Pretty Builder+showPrefixedName :: (Monad m, MonadThrow m)+ => [Prefix] -> UnqualifiedName -> Pretty m Builder showPrefixedName = go mempty where go acc pfxs uname = case (pfxs, uname) of- ([], SourceName n) ->- return $! mconcat [ acc, fromString "::", fromString n ]+ ([], SourceName n) -> do+ recordSubstitution $! mconcat [ acc, fromString "::", fromString n ] ([], OperatorName op) -> do ob <- showOperator op+ recordSubstitution' ob case acc == mempty of False -> return $! mconcat [ acc, fromString "::operator", ob ] True -> return $! mconcat [ fromString "operator", ob ]@@ -185,17 +429,33 @@ False -> fromString "::" True -> fromString "::~" sub = curPfx `mappend` fromString className- recordSubstitution sub+ recordSubstitution' sub return $! mconcat [ curPfx, fromString className, inFix, fromString className ]+ ([UnqualifiedPrefix (SourceName className), tmplPfx@(TemplateArgsPrefix{})], CtorDtorName cd) -> do+ let prevPfx here = case acc == mempty of+ True -> here+ False -> mconcat [ acc, fromString "::", here ]+ nextAcc <- showPrefix (prevPfx $ fromString className) tmplPfx+ let inFix = case isDestructor cd of+ False -> fromString "::"+ True -> fromString "::~"+ return $! mconcat [ nextAcc, inFix, fromString className ] (outerPfx : innerPfxs, _) -> do- px <- showPrefix outerPfx- let nextAcc = case acc == mempty of- False -> mconcat [ acc, fromString "::", px ]- True -> px- recordSubstitution nextAcc+ nextAcc <- showPrefix acc outerPfx go nextAcc innerPfxs uname- ([], CtorDtorName _) -> error "Illegal fallthrough in constructor/destructor case"+ ([], CtorDtorName _) -> throwM 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 _ = "Illegal fallthrough in constructor/destructor case"+ isDestructor :: CtorDtor -> Bool isDestructor cd = case cd of@@ -204,40 +464,78 @@ D2 -> True _ -> False -showQualifiers :: [CVQualifier] -> Builder-showQualifiers qs =+showQualifiers :: Monad m => Builder -> [CVQualifier] -> Pretty m Builder+showQualifiers qualifies qs = case null qs of- True -> mempty- False ->- let qs' = map showQualifier qs- in mconcat qs'+ True -> return mempty+ False -> snd <$> foldM showQualifier (qualifies,mempty) qs -showQualifier :: CVQualifier -> Builder-showQualifier q =- case q of- Restrict -> fromString "restrict"- Volatile -> fromString "volatile"- Const -> fromString "const"+showQualifier :: Monad m+ => (Builder, Builder) -> CVQualifier+ -> Pretty m (Builder, Builder)+showQualifier (accum,res) 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 = case q of+ Restrict -> fromString "restrict"+ Volatile -> fromString "volatile"+ Const -> fromString "const"+ acc' = mconcat [ accum, singleton ' ', qual ]+ res' = case res == mempty of+ True -> qual+ False -> mconcat [ res, singleton ' ', qual ]+ recordSubstitution' acc'+ return $! (acc', res') ++showPrefixes :: (Monad m, MonadThrow m) => [Prefix] -> Pretty m Builder+showPrefixes = foldM showPrefix mempty+ -- | These are outer namespace/class name qualifiers, so convert them -- to strings followed by ::-showPrefix :: Prefix -> Pretty Builder-showPrefix pfx =- case pfx of- DataMemberPrefix s -> return $! fromString s- UnqualifiedPrefix uname -> showUnqualifiedName uname- SubstitutionPrefix s -> showSubstitution s+showPrefix :: (Monad m, MonadThrow m) => Builder -> Prefix -> Pretty m Builder+showPrefix prior pfx =+ let addPrior doRecord toThis = do+ let ret = case prior == mempty of+ False -> mconcat [ prior, fromString "::", toThis ]+ True -> toThis+ if doRecord then recordSubstitution ret else return ret+ in case pfx of+ DataMemberPrefix s -> addPrior True $ fromString s+ UnqualifiedPrefix uname -> addPrior True =<< showUnqualifiedName uname+ SubstitutionPrefix s -> addPrior False =<< showSubstitution s+ TemplateArgsPrefix args ->+ case prior == mempty of+ True -> (templateBracket <$> showTArgs args) >>= recordSubstitution+ False -> do recordSubstitution' prior+ targs <- showTArgs args+ let this = mconcat [ prior, templateBracket targs ]+ recordSubstitution this -showUnqualifiedName :: UnqualifiedName -> Pretty Builder+showUnqualifiedName :: (Monad m, MonadThrow m)+ => UnqualifiedName -> Pretty m Builder showUnqualifiedName uname = case uname of OperatorName op -> do ob <- showOperator op return (fromString "operator" `mappend` ob)- CtorDtorName _ -> error "showUnqualifiedName shouldn't reach the ctor/dtor case"- SourceName s -> return (fromString s)+ CtorDtorName _ -> throwM UnqualCtorDtor+ SourceName s -> return (fromString s) -- KWQ: add Substitution? "C" extern func? -showOperator :: Operator -> Pretty Builder+-- | 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 _ = "showUnqualifiedName shouldn't reach the ctor/dtor case?"++showOperator :: (Monad m, MonadThrow m) => Operator -> Pretty m Builder showOperator op = case op of OpNew -> return $! fromString " new"@@ -296,14 +594,13 @@ return $! singleton ' ' `mappend` tb OpVendor n oper -> return $! fromString ("vendor" ++ show n ++ oper) -- ?? -showType :: CXXType -> Pretty Builder+showType :: (Monad m, MonadThrow m) => CXXType -> Pretty m Builder showType t = case t of QualifiedType qs t' -> do tb <- showType t'- let r = mconcat [ tb, singleton ' ', showQualifiers qs ]- recordSubstitution r- return $! r+ quals <- showQualifiers tb qs+ return $! mconcat [ tb, singleton ' ' ] `mappend` quals PointerToType (FunctionType ts) -> do -- Since we don't explicitly descend the FunctionType here, we -- need to create a stub entry in the substitution table for it@@ -311,40 +608,40 @@ -- stub will never be referenced because function types aren't -- first-class ts' <- mapM showType ts- recordSubstitution (mconcat ts')+ if null ts'+ then return()+ else recordSubstitution'+ $ mconcat [ head ts'+ , fromString " ("+ , mconcat $ intersperse (fromString ", ") $ tail ts'+ , singleton ')'+ ] r <- showFunctionType ts- recordSubstitution r- return $! r+ recordSubstitution $! r PointerToType t' -> do tb <- showType t' let r = tb `mappend` singleton '*'- recordSubstitution r- return $! r+ recordSubstitution $! r ReferenceToType t' -> do tb <- showType t' let r = tb `mappend` singleton '&'- recordSubstitution r- return $! r+ recordSubstitution $! r RValueReferenceToType t' -> do tb <- showType t' let r = tb `mappend` fromString "&&"- recordSubstitution r- return $! r+ recordSubstitution $! r ComplexPairType t' -> do tb <- showType t' let r = tb `mappend` fromString " complex"- recordSubstitution r return $! r ImaginaryType t' -> do tb <- showType t' let r = tb `mappend` fromString " imaginary"- recordSubstitution r return $! r ParameterPack _ -> undefined VendorTypeQualifier q t' -> do tb <- showType t' let r = mconcat [ fromString q, singleton ' ', tb ]- recordSubstitution r return $! r VoidType -> return $! fromString "void" Wchar_tType -> return $! fromString "wchar_t"@@ -372,33 +669,40 @@ AutoType -> return $! fromString "auto" NullPtrType -> return $! fromString "std::nullptr_t" VendorBuiltinType s -> return $! fromString s- FunctionType _ -> error "Only pointers to function types are supported"+ FunctionType _ -> throwM NonPointerFunctionType ExternCFunctionType ts -> do tb <- showFunctionType ts let r = fromString "extern \"C\" " `mappend` tb- recordSubstitution r return $! r ArrayTypeN (Just n) t' -> do tb <- showType t' let r = mconcat [ tb, singleton '[', fromString (show n), singleton ']' ]- recordSubstitution r return $! r ArrayTypeN Nothing t' -> do tb <- showType t' let r = tb `mappend` fromString "[]"- recordSubstitution r return $! r ClassEnumType n -> do r <- showName n- recordSubstitution r- return r+ q <- showNameQualifiers r n+ recordSubstitution $! mconcat [r, q] PtrToMemberType c m -> do r <- showPtrToMember c m- recordSubstitution r return $! r SubstitutionType s -> showSubstitution s+ TemplateParamType tt -> showTemplateParam tt -showSubstitution :: Substitution -> Pretty Builder+-- | 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 _ = "Only pointers to function types are supported"++showSubstitution :: (Monad m, MonadThrow m) => Substitution -> Pretty m Builder showSubstitution s = case s of Substitution ss -> getSubstitution ss@@ -410,21 +714,36 @@ SubBasicOstream -> return $! fromString "std::basic_ostream<char, std::char_traits<char> >" SubBasicIostream -> return $! fromString "std::basic_iostream<char, std::char_traits<char> >" -showPtrToMember :: CXXType -> CXXType -> Pretty Builder+showTemplateParam :: (Monad m, MonadThrow m) => TemplateParam -> Pretty m Builder+showTemplateParam (TemplateParam t) = do r <- getTemplateArgument t+ recordSubstitutionAlways r++showPtrToMember :: (Monad m, MonadThrow m)+ => CXXType -> CXXType -> Pretty m Builder showPtrToMember (ClassEnumType n) (FunctionType (rt:argts)) = do rt' <- showType rt argts' <- mapM showType argts nb <- showName n- return $! mconcat [ rt', fromString " (", nb , fromString "::*)("+ q <- showNameQualifiers nb n+ return $! mconcat [ rt', fromString " (", nb, q , fromString "::*)(" , mconcat (intersperse (fromString ", ") argts') , singleton ')' ]-showPtrToMember _ _ = error "Expected a ClassEnumType and FunctionType pair for PtrToMemberType"+showPtrToMember _ _ = throwM BarePtrToMember -showFunctionType :: [CXXType] -> Pretty Builder+-- | 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 _ = "Expected a ClassEnumType and FunctionType pair for PtrToMemberType"++showFunctionType :: (Monad m, MonadThrow m) => [CXXType] -> Pretty m Builder showFunctionType ts = case ts of- [] -> error "Empty type list in function type"+ [] -> throwM EmptyFunctionType [rtype, VoidType] -> do rt' <- showType rtype return $! mconcat [ rt', fromString " (*)()" ]@@ -434,9 +753,22 @@ let arglist = mconcat $ intersperse (fromString ", ") rbs return $! mconcat [ tb, fromString " (*)(", arglist, singleton ')' ] +-- | 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 _ = "Empty type list in function type"+ -- Helpers -- Taken from parsec-numbers-numberValue :: Integral i => Int -> String -> i+numberValue :: Integral i => Int -> String -> Maybe i numberValue base =- foldl' (\ x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0+ let seqIdToNum seqId | seqId >= ord 'A' && seqId <= ord 'Z' = Just $ seqId - ord 'A' + 10+ | seqId >= ord '0' && seqId <= ord '9' = Just $ seqId - ord '0'+ | otherwise = Nothing+ in+ foldM (\ x -> fmap (((fromIntegral base * x) +) . fromIntegral) . seqIdToNum . ord) 0
src/ABI/Itanium/Types.hs view
@@ -13,7 +13,8 @@ CallOffset(..), Substitution(..), TemplateArg(..),- TemplateParam(..)+ TemplateParam(..),+ ExprPrimary(..) ) where import Data.Data@@ -27,6 +28,31 @@ | GuardVariable Name | OverrideThunk CallOffset DecodedName | OverrideThunkCovariant CallOffset CallOffset DecodedName++ | ConstStructData UnqualifiedName+ -- ^ Const data that is not a builtin data type (as+ -- a <special-name>).+ --+ -- This construct is not specifically identified in+ -- the documentation, but for the following input:+ --+ -- struct mystr { int val; };+ -- const struct mystr here = { 9 };+ --+ -- Also works with:+ --+ -- class mycls { public: int val; }+ -- const class mycls here = { 8 };+ --+ -- When compiled with Clang/LLVM results in Global+ -- Variable (apparently always using the+ -- length-specified <source-name> syntax):+ --+ -- _ZL4here+ --+ -- This is apparently only used for const+ -- declarations and only for non-builtin datatypes.+ deriving (Eq, Ord, Show, Data, Typeable) data CallOffset = VirtualOffset Int Int@@ -139,10 +165,20 @@ deriving (Eq, Ord, Show, Data, Typeable) data TemplateArg = TypeTemplateArg CXXType+ | ExprPrimaryTemplateArg ExprPrimary deriving (Eq, Ord, Show, Data, Typeable) -data TemplateParam = TemplateParam (Maybe Int)+data TemplateParam = TemplateParam (Maybe String) deriving (Eq, Ord, Show, Data, Typeable)++data ExprPrimary = ExprIntLit CXXType Int+ | ExprFloatLit CXXType Float+ | ExprStringLit String+ | ExprNullPtrLit -- ?+ | ExprNullPointerTemplateArg+ | ExprComplexFloatLit CXXType Float Float+ | ExprExternName DecodedName+ deriving (Eq, Ord, Show, Data, Typeable) data UnqualifiedName = OperatorName Operator | CtorDtorName CtorDtor
tests/DemangleTests.hs view
@@ -13,9 +13,11 @@ case demangleName sym of Left err -> assertFailure (sym ++ " : " ++ err) Right dname ->- assertEqual sym (normalize expected) (normalize (cxxNameToString dname))+ case cxxNameToString dname of+ Left err -> assertFailure (sym ++ " pretty-printing: " ++ show err)+ Right s -> assertEqual sym (normalize expected) (normalize s) where- normalize = filter (`notElem` " \n")+ normalize = filter (`notElem` "\n") main :: IO () main = do
tests/test-cases.txt view
@@ -14020,3 +14020,32 @@ _ZrsR11QDataStreamR9QVector3D _ZrsR11QDataStreamR9QVector4D _ZrsR11QTextStreamR9QSplitter+_ZL13testconstdata+_ZN4uorbIvE9uorb_copyEPK12orb_metadataiPv+_ZN4uorbIvEC2Ei+_ZN3foo4foo1EPiS0_+_ZN3foo4foo1EiPicS0_+_ZN3foo4foo1EiPicS0_PFiS0_S0_PdS1_ES3_+_ZN3fooC2ERKc+_Z16vehicle_gps_stopR3fooPiS1_Oc+_Z16vehicle_gps_stopR3fooPiS1_OcS2_RiS0_S3_+_Z17vehicle_gps_startRK10gps_statusI16geographical_arcE+_Z16vehicle_gps_townRK10gps_statusI16geographical_arcES3_+_Z16vehicle_gps_townRK10gps_statusI16geographical_arcEPS2_+_ZL11hrt_tim_isrPv+_ZN4uORB11PublicationI18vehicle_attitude_sLh1EE7publishERKS1_+_ZN6matrix10QuaternionIfEC2ERKNS_7Vector3IfEES5_f+_ZNSt3mapINSt7__cxx1112basic_stringIcSt11char_traitsIcESaIcEEES5_St4lessIS5_ESaISt4pairIKS5_S5_EEEixERS9_+_ZNSt8_Rb_treeINSt7__cxx1112basic_stringIcSt11char_traitsIcESaIcEEESt4pairIKS5_PFiiPPcEESt10_Select1stISC_ESt4lessIS5_ESaISC_EE14_M_insert_nodeEPSt18_Rb_tree_node_baseSK_PSt13_Rb_tree_nodeISC_E+_ZNSt8_Rb_treeINSt7__cxx1112basic_stringIcSt11char_traitsIcESaIcEEESt4pairIKS5_PFiiPPcEESt10_Select1stISC_ESt4lessIS5_ESaISC_EE14_M_insert_nodeEPSt18_Rb_tree_node_baseSK_PSt13_Rb_tree_nodeISC_wS_S0_S1_S2_S3_S4_S5_S6_S7_S8_S9_SA_SB_SC_SD_SE_SF_SG_SH_SI_SJ_SK_E+_ZN3kwq2qqEi+_ZN3kwq3qqqEicPiS_S0_+_ZN3kwqIcEE+_Z3kwqicPiS_+_Z16vehicle_gps_townRK10gps_statusI16geographical_arcEPS2_+_Z16vehicle_gps_townRK10gps_statusI16geographical_arcEPS2_S_S0_S1_S2_+_ZN9__gnu_cxx12__to_xstringINSt7__cxx1112basic_stringIcSt11char_traitsIcESaIcEEEcEET_PFiPT0_mPKS8_P13__va_list_tagEmSB_z+_ZN9__gnu_cxx12__to_xstringINSt7__cxx1112basic_stringIcSt11char_traitsIcESaIcEEEcEET_PFiPT_mPKS_S1_S2_S3_S4_S5_S6_S7_wS8_bS9_P13__va_list_tagEmSA_bSB_sSC_T0_T_z+_ZN9__gnu_cxx12__to_xstringINSt7__cxx1112basic_stringIcSt11char_traitsIcESaIcEEEcEET_PFiPT0_mPKS_S1_S2_S3_S4_S5_S6_S7_wS8_bS9_P13__va_list_tagEmSA_bSB_sSC_T0_T_z+_Z1fIiEvT_+_ZNSt3__110moneypunctIcLb0EED0Ev