itanium-abi (empty) → 0.1.0.0
raw patch · 7 files changed
+1051/−0 lines, 7 filesdep +HUnitdep +basedep +boomerangsetup-changed
Dependencies added: HUnit, base, boomerang, itanium-abi, process, test-framework, test-framework-hunit, text, transformers, unordered-containers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- itanium-abi.cabal +35/−0
- src/ABI/Itanium.hs +303/−0
- src/ABI/Itanium/Pretty.hs +442/−0
- src/ABI/Itanium/Types.hs +214/−0
- tests/DemangleTests.hs +25/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Tristan Ravitch++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Tristan Ravitch nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ itanium-abi.cabal view
@@ -0,0 +1,35 @@+-- Initial itanium-abi.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: itanium-abi+version: 0.1.0.0+synopsis: An implementation of name mangling/demangling for the Itanium ABI+license: BSD3+license-file: LICENSE+author: Tristan Ravitch+maintainer: travitch@cs.wisc.edu+category: Development+build-type: Simple+cabal-version: >=1.10+description: Currently supports everything in the standard but templates+ and C++11. Support for these will be added. Includes a name+ mangler, demangler, and pretty printer.+-- copyright:++library+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall+ build-depends: base > 3 && < 5, boomerang, text, transformers, unordered-containers+ exposed-modules: ABI.Itanium+ other-modules: ABI.Itanium.Types,+ ABI.Itanium.Pretty++test-suite DemangleTests+ default-language: Haskell2010+ hs-source-dirs: tests+ type: exitcode-stdio-1.0+ main-is: DemangleTests.hs+ build-depends: itanium-abi, base > 3 && < 5, process,+ test-framework, test-framework-hunit, HUnit+ ghc-options: -Wall
+ src/ABI/Itanium.hs view
@@ -0,0 +1,303 @@+{-# LANGUAGE TemplateHaskell, TypeOperators #-}+module ABI.Itanium (+ DecodedName(..),+ CVQualifier(..),+ CXXType(..),+ Name(..),+ Prefix(..),+ UnqualifiedName(..),+ CtorDtor(..),+ Operator(..),+ Expression(..),+ CallOffset(..),+ Substitution(..),+ UName(..),+ demangleName,+ mangleName,+ cxxNameToString,+ cxxNameToText,+ -- * Generated parsers+ rUnqualifiedPrefix,+ rConst,+ rSourceName,+ rUName,+ rNestedName,+ rUnscopedName+ ) where++import Prelude hiding ( (.) )+import Control.Category ( (.) )+import Text.Boomerang+import Text.Boomerang.String+import Text.Boomerang.TH++import ABI.Itanium.Pretty+import ABI.Itanium.Types++$(derivePrinterParsers ''DecodedName)+$(derivePrinterParsers ''Name)+$(derivePrinterParsers ''CVQualifier)+$(derivePrinterParsers ''CXXType)+$(derivePrinterParsers ''Operator)+$(derivePrinterParsers ''CtorDtor)+$(derivePrinterParsers ''UnqualifiedName)+$(derivePrinterParsers ''Prefix)+$(derivePrinterParsers ''CallOffset)+$(derivePrinterParsers ''Substitution)+$(derivePrinterParsers ''UName)+$(derivePrinterParsers ''TemplateArg)+$(derivePrinterParsers ''TemplateParam)++-- | Demangle a name into a structured representation (or an error+-- string)+demangleName :: String -> Either String DecodedName+demangleName s =+ case parseString itaniumName s of+ Right n -> Right n+ Left e -> Left (show e)++-- | Re-mangle a name+mangleName :: DecodedName -> Maybe String+mangleName = unparseString itaniumName++itaniumName :: StringPrinterParser () (DecodedName :- ())+itaniumName = lit "_Z" . topLevelEntity++topLevelEntity :: PrinterParser StringError String a (DecodedName :- a)+topLevelEntity =+ ( rVirtualTable . lit "TV" . cxxType <>+ rVTTStructure . lit "TT" . cxxType <>+ rTypeInfo . lit "TI" . cxxType <>+ rTypeInfoName . lit "TS" . cxxType <>+ rGuardVariable . lit "GV" . name <>+ rOverrideThunk . lit "T" . callOffset . topLevelEntity <>+ rOverrideThunkCovariant . lit "Tc" . callOffset . callOffset . topLevelEntity <>+ rFunction . name . bareFunctionType <>+ rData . name+ )+++-- | Equivalent to the <type> production in the Itanium ABI spec+--+-- FIXME: Add support for unnamed types and decltypes+--+-- <unnamed-type-name> ::= Ut [ <nonnegative number> ] _+-- <decltype> ::= Dt <expression> E # decltype of an id-expression or class member access (C++0x)+-- ::= DT <expression> E # decltype of an expression (C++0x)+cxxType :: PrinterParser StringError String a (CXXType :- a)+cxxType = ( rQualifiedType . rList1 cvQualifier . cxxType <>+ rPointerToType . lit "P" . cxxType <>+ rReferenceToType . lit "R" . cxxType <>+ rRValueReferenceToType . lit "O" . cxxType <>+ rComplexPairType . lit "C" . cxxType <> -- C99+ rImaginaryType . lit "G" . cxxType <> -- C99+ rParameterPack . lit "Dp" . cxxType <> -- C++11 parameter pack+ rVendorTypeQualifier . lit "U" . sourceName . cxxType <>+ rVoidType . lit "v" <>+ rWchar_tType . lit "w" <>+ rBoolType . lit "b" <>+ rCharType . lit "c" <>+ rSignedCharType . lit "a" <>+ rUnsignedCharType . lit "h" <>+ rShortType . lit "s" <>+ rUnsignedShortType . lit "t" <>+ rIntType . lit "i" <>+ rUnsignedIntType . lit "j" <>+ rLongType . lit "l" <>+ rUnsignedLongType . lit "m" <>+ rLongLongType . lit "x" <>+ rUnsignedLongLongType . lit "y" <>+ rInt128Type . lit "n" <>+ rUnsignedInt128Type . lit "o" <>+ rFloatType . lit "f" <>+ rDoubleType . lit "d" <>+ rLongDoubleType . lit "e" <>+ rFloat128Type . lit "g" <>+ rEllipsisType . lit "z" <>+ rChar32Type . lit "Di" <>+ rChar16Type . lit "Ds" <>+ rAutoType . lit "Da" <>+ rNullPtrType . lit "Dn" <>+ rVendorBuiltinType . lit "u" . sourceName <>+ rExternCFunctionType . lit "FY" . bareFunctionType . lit "E" <>+ rFunctionType . lit "F" . bareFunctionType . lit "E" <>+ rArrayTypeN . lit "A" . rMaybe int . lit "_" . cxxType <>+ rPtrToMemberType . lit "M" . cxxType . cxxType <>+ rSubstitutionType . substitution <>+ rClassEnumType . name+ -- Still need: array-type (E), decltype+ )++bareFunctionType :: PrinterParser StringError String a ([CXXType] :- a)+bareFunctionType = rList1 cxxType++callOffset :: PrinterParser StringError String a (CallOffset :- a)+callOffset = ( rVirtualOffset . lit "v" . abiInt . lit "_" . abiInt . lit "_" <>+ rNonVirtualOffset . lit "h" . abiInt . lit "_"+ )++cvQualifier :: PrinterParser StringError String a (CVQualifier :- a)+cvQualifier = ( rRestrict . lit "r" <>+ rVolatile . lit "V" <>+ rConst . lit "K"+ )++operator :: PrinterParser StringError String a (Operator :- a)+operator = ( rOpNew . lit "nw" <>+ rOpNewArray . lit "na" <>+ rOpDelete . lit "dl" <>+ rOpDeleteArray . lit "da" <>+ rOpUPlus . lit "ps" <>+ rOpUMinus . lit "ng" <>+ rOpAddressOf . lit "ad" <>+ rOpDeref . lit "de" <>+ rOpBitNot . lit "co" <>+ rOpPlus . lit "pl" <>+ rOpMinus . lit "mi" <>+ rOpMul . lit "ml" <>+ rOpDiv . lit "dv" <>+ rOpMod . lit "rm" <>+ rOpBitAnd . lit "an" <>+ rOpBitOr . lit "or" <>+ rOpBitXor . lit "eo" <>+ rOpAssign . lit "aS" <>+ rOpPlusAssign . lit "pL" <>+ rOpMinusAssign . lit "mI" <>+ rOpMulAssign . lit "mL" <>+ rOpDivAssign . lit "dV" <>+ rOpModAssign . lit "rM" <>+ rOpAndAssign . lit "aN" <>+ rOpOrAssign . lit "oR" <>+ rOpXorAssign . lit "eO" <>+ rOpShl . lit "ls" <>+ rOpShr . lit "rs" <>+ rOpShlAssign . lit "lS" <>+ rOpShrAssign . lit "rS" <>+ rOpEquals . lit "eq" <>+ rOpNotEquals . lit "ne" <>+ rOpLt . lit "lt" <>+ rOpGt . lit "gt" <>+ rOpLte . lit "le" <>+ rOpGte . lit "ge" <>+ rOpNot . lit "nt" <>+ rOpAnd . lit "aa" <>+ rOpOr . lit "oo" <>+ rOpPlusPlus . lit "pp" <>+ rOpMinusMinus . lit "mm" <>+ rOpComma . lit "cm" <>+ rOpArrowStar . lit "pm" <>+ rOpArrow . lit "pt" <>+ rOpCall . lit "cl" <>+ rOpIndex . lit "ix" <>+ rOpQuestion . lit "qu" <>+ rOpSizeofType . lit "st" <>+ rOpSizeofExpr . lit "sz" <>+ rOpAlignofType . lit "at" <>+ rOpAlignofExpr . lit "az" <>+ rOpCast . lit "cv" . cxxType <>+ rOpVendor . lit "v" . abiInt . sourceName+ )++ctorDtor :: PrinterParser StringError String a (CtorDtor :- a)+ctorDtor = ( rC1 . lit "C1" <>+ rC2 . lit "C2" <>+ rC3 . lit "C3" <>+ rD0 . lit "D0" <>+ rD1 . lit "D1" <>+ rD2 . lit "D2"+ )++unqualifiedName :: PrinterParser StringError String a (UnqualifiedName :- a)+unqualifiedName = ( rOperatorName . operator <>+ rCtorDtorName . ctorDtor <>+ rSourceName . sourceName+ )++prefix :: PrinterParser StringError String a (Prefix :- a)+prefix = ( rDataMemberPrefix . sourceName . lit "M" <>+ rUnqualifiedPrefix . unqualifiedName <>+ rSubstitutionPrefix . substitution <>+ rTemplateParamPrefix . templateParam <>+ rTemplateArgsPrefix . templateArgs+ )++name :: PrinterParser StringError String a (Name :- a)+name = ( rNestedName . lit "N" . rList cvQualifier . rList1 prefix . unqualifiedName . lit "E" <>+ rNestedTemplateName . lit "N" . rList cvQualifier . rList1 prefix . templateArgs . lit "E" <>+ rUnscopedTemplateName . unscopedName . templateArgs <>+ rUnscopedTemplateSubstitution . substitution . templateArgs <>+ rUnscopedName . unscopedName+ )++substitution :: PrinterParser StringError String a (Substitution :- a)+substitution = ( rSubstitution . lit "S" . rMaybe (rList1 (satisfy (/='_'))) . lit "_" <>+ rSubStdNamespace . lit "St" <>+ rSubStdAllocator . lit "Sa" <>+ rSubBasicString . lit "Sb" <>+ rSubBasicStringArgs . lit "Ss" <>+ rSubBasicIstream . lit "Si" <>+ rSubBasicOstream . lit "So" <>+ rSubBasicIostream . lit "Sd"+ )++unscopedName :: PrinterParser StringError String a (UName :- a)+unscopedName = ( rUStdName . lit "St" . unqualifiedName <>+ rUName . unqualifiedName+ )++templateArgs :: PrinterParser StringError String a ([TemplateArg] :- a)+templateArgs = lit "I" . rList1 templateArg . lit "E"++templateArg :: PrinterParser StringError String a (TemplateArg :- a)+templateArg = rTypeTemplateArg . cxxType++templateParam :: PrinterParser StringError String a (TemplateParam :- a)+templateParam = ( rTemplateParam . lit "T" . rMaybe int . lit "_" )++-- | Parse a length-prefixed string (does not handle newlines)+sourceName :: PrinterParser (ParserError MajorMinorPos) String a (String :- a)+sourceName = val pf sf+ where+ pf = Parser $ \tok pos ->+ case tok of+ [] -> mkParserError pos [EOI "input", Expect "number"]+ _ ->+ case parseInt tok of+ Nothing -> mkParserError pos [Expect "length-prefixed string"]+ Just (len, rest1) ->+ let (s, rest2) = splitAt len rest1+ pos' = incMinor (length (show len) + length s) pos+ in case length s == len of+ True -> [Right ((s, rest2), pos')]+ False -> mkParserError pos [EOI "input", Expect "length-prefixed string"]+ sf b = [ (\string -> concat [ show (length b), b, string ]) ]++parseInt :: String -> Maybe (Int, String)+parseInt s =+ case reads s of+ [(i, rest)] -> Just (i, rest)+ _ -> Nothing++-- | In the Itanium ABI, negative numbers are prefixed by 'n' instead+-- of a negative sign. This is an alternate parser to be used instead+-- of the 'int' parser that comes with boomerang.+abiInt :: PrinterParser (ParserError MajorMinorPos) String a (Int :- a)+abiInt = val pf sf+ where+ pf = Parser $ \tok pos ->+ case tok of+ [] -> mkParserError pos [EOI "input", Expect "abi number"]+ 'n' : rest1 ->+ case parseInt rest1 of+ Nothing -> mkParserError pos [Expect "abi number"]+ Just (num, rest2) ->+ let pos' = incMinor (length (show num) + 1) pos+ in [Right ((negate num, rest2), pos')]+ _ ->+ case parseInt tok of+ Nothing -> mkParserError pos [Expect "abi number"]+ Just (num, rest2) ->+ let pos' = incMinor (length (show num)) pos+ in [Right ((num, rest2), pos')]+ sf b | b >= 0 = [ (\string -> concat [ show b, string ]) ]+ | otherwise = [ (\string -> concat [ "n", show b, string ]) ]
+ src/ABI/Itanium/Pretty.hs view
@@ -0,0 +1,442 @@+module ABI.Itanium.Pretty (+ cxxNameToString,+ cxxNameToText+ ) where++import Control.Monad.Trans.State.Strict+import Data.Char ( digitToInt )+import Data.List ( foldl', 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.Text.Lazy.Builder++import ABI.Itanium.Types++type Pretty = State (HashMap Int Builder)++-- Only record substitutions that were not previously seen+recordSubstitution :: Builder -> Pretty ()+recordSubstitution b = do+ s <- get+ case b `elem` HM.elems s of+ False -> do+ let n = HM.size s+ put $! HM.insert n b s+ True -> return ()++getSubstitution :: Maybe String -> Pretty Builder+getSubstitution s = do+ st <- get+ case s of+ Nothing -> return $! 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+ where+ errMsg = error ("No substitution found for " ++ show s)+ lookupError k m = fromMaybe errMsg (HM.lookup k m)++cxxNameToText :: DecodedName -> Text+cxxNameToText n = toLazyText $ evalState (dispatchTopLevel n) mempty++cxxNameToString :: DecodedName -> String+cxxNameToString = unpack . cxxNameToText++dispatchTopLevel :: DecodedName -> Pretty 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+ VirtualTable t -> do+ tb <- showType t+ return $! mconcat [ fromString "vtable for ", tb ]+ VTTStructure t -> do+ tb <- showType t+ return $! mconcat [ fromString "<vttstruct for ", tb, singleton '>' ]+ TypeInfo t -> do+ tb <- showType t+ return $! mconcat [ fromString "typeinfo for ", tb ]+ TypeInfoName t -> do+ tb <- showType t+ return $! mconcat [ fromString "typeinfo name for ", tb ]+ GuardVariable vname -> do+ vn <- showName vname+ return $! mconcat [ fromString "guard variable for ", vn ]+ OverrideThunk _ target -> do+ tn <- dispatchTopLevel target+ return $! mconcat [ fromString "non-virtual thunk to ", tn ]+ OverrideThunkCovariant _ _ target -> do+ tn <- dispatchTopLevel target+ return $! mconcat [ fromString "virtual thunk to ", tn ]++showName :: Name -> Pretty Builder+showName n =+ case n of+ NestedName qs pfxs uname -> do+ pn <- showPrefixedName pfxs uname+ case null qs of+ False -> return $! mconcat [ pn, singleton ' ', showQualifiers qs ]+ True -> return $! 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 ]+ UnscopedTemplateName uname targs -> do+ un <- showUName uname+ recordSubstitution un+ tns <- showTArgs targs+ return $! mconcat [ un, singleton '<'+ , tns+ , singleton '>'+ ]+ UnscopedTemplateSubstitution s targs -> do+ ss <- showSubstitution s+ tns <- showTArgs targs+ return $! mconcat [ ss, singleton '<', tns, singleton '>' ]++showUName :: UName -> Pretty Builder+showUName u =+ case u of+ UName uname -> showUnqualifiedName uname+ UStdName uname -> do+ un <- showUnqualifiedName uname+ return (fromString "std::" `mappend` un)++showTArgs :: [TemplateArg] -> Pretty 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 ta =+ case ta of+ TypeTemplateArg t -> showType t++-- pass the current prefix builder down so that it can be added to and+-- stored for substitutions+showPrefixedName :: [Prefix] -> UnqualifiedName -> Pretty Builder+showPrefixedName = go mempty+ where+ go acc pfxs uname =+ case (pfxs, uname) of+ ([], SourceName n) ->+ return $! mconcat [ acc, fromString "::", fromString n ]+ ([], OperatorName op) -> do+ ob <- showOperator op+ case acc == mempty of+ False -> return $! mconcat [ acc, fromString "::operator", ob ]+ True -> return $! mconcat [ fromString "operator", 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 className)], CtorDtorName cd) -> do+ let curPfx =+ case acc == mempty of+ False -> acc `mappend` fromString "::"+ True -> mempty+ inFix = case isDestructor cd of+ False -> fromString "::"+ True -> fromString "::~"+ sub = curPfx `mappend` fromString className+ recordSubstitution sub+ return $! mconcat [ curPfx, fromString className, inFix, fromString className ]+ (outerPfx : innerPfxs, _) -> do+ px <- showPrefix outerPfx+ let nextAcc = case acc == mempty of+ False -> mconcat [ acc, fromString "::", px ]+ True -> px+ recordSubstitution nextAcc+ go nextAcc innerPfxs uname+ ([], CtorDtorName _) -> error "Illegal fallthrough in constructor/destructor case"++isDestructor :: CtorDtor -> Bool+isDestructor cd =+ case cd of+ D0 -> True+ D1 -> True+ D2 -> True+ _ -> False++showQualifiers :: [CVQualifier] -> Builder+showQualifiers qs =+ case null qs of+ True -> mempty+ False ->+ let qs' = map showQualifier qs+ in mconcat qs'++showQualifier :: CVQualifier -> Builder+showQualifier q =+ case q of+ Restrict -> fromString "restrict"+ Volatile -> fromString "volatile"+ Const -> fromString "const"++-- | 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++showUnqualifiedName :: UnqualifiedName -> Pretty 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)++showOperator :: Operator -> Pretty Builder+showOperator op =+ case op of+ OpNew -> return $! fromString " new"+ OpNewArray -> return $! fromString " new[]"+ OpDelete -> return $! fromString " delete"+ OpDeleteArray -> return $! fromString " delete[]"+ OpUPlus -> return $! singleton '+'+ OpUMinus -> return $! singleton '-'+ OpAddressOf -> return $! singleton '&'+ OpDeref -> return $! singleton '*'+ OpBitNot -> return $! singleton '~'+ OpPlus -> return $! singleton '+'+ OpMinus -> return $! singleton '-'+ OpMul -> return $! singleton '*'+ OpDiv -> return $! singleton '/'+ OpMod -> return $! singleton '%'+ OpBitAnd -> return $! singleton '&'+ OpBitOr -> return $! singleton '|'+ OpBitXor -> return $! singleton '^'+ OpAssign -> return $! singleton '='+ OpPlusAssign -> return $! fromString "+="+ OpMinusAssign -> return $! fromString "-="+ OpMulAssign -> return $! fromString "*="+ OpDivAssign -> return $! fromString "/="+ OpModAssign -> return $! fromString "%="+ OpAndAssign -> return $! fromString "&="+ OpOrAssign -> return $! fromString "|="+ OpXorAssign -> return $! fromString "^="+ OpShl -> return $! fromString "<<"+ OpShr -> return $! fromString ">>"+ OpShlAssign -> return $! fromString "<<="+ OpShrAssign -> return $! fromString ">>="+ OpEquals -> return $! fromString "=="+ OpNotEquals -> return $! fromString "!="+ OpLt -> return $! singleton '<'+ OpGt -> return $! singleton '>'+ OpLte -> return $! fromString "<="+ OpGte -> return $! fromString ">="+ OpNot -> return $! singleton '!'+ OpAnd -> return $! fromString "&&"+ OpOr -> return $! fromString "||"+ OpPlusPlus -> return $! fromString "++"+ OpMinusMinus -> return $! fromString "--"+ OpComma -> return $! singleton ','+ OpArrowStar -> return $! fromString "->*"+ OpArrow -> return $! fromString "->"+ OpCall -> return $! fromString "()"+ OpIndex -> return $! fromString "[]"+ OpQuestion -> return $! singleton '?'+ OpSizeofType -> return $! fromString " sizeof"+ OpSizeofExpr -> return $! fromString " sizeof"+ OpAlignofType -> return $! fromString " alignof"+ OpAlignofExpr -> return $! fromString " alignof"+ OpCast t -> do+ tb <- showType t+ return $! singleton ' ' `mappend` tb+ OpVendor n oper -> return $! fromString ("vendor" ++ show n ++ oper) -- ??++showType :: CXXType -> Pretty Builder+showType t =+ case t of+ QualifiedType qs t' -> do+ tb <- showType t'+ let r = mconcat [ tb, singleton ' ', showQualifiers qs ]+ recordSubstitution r+ return $! r+ 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+ -- (otherwise the pointer to the type will be off by one). The+ -- stub will never be referenced because function types aren't+ -- first-class+ ts' <- mapM showType ts+ recordSubstitution (mconcat ts')+ r <- showFunctionType ts+ recordSubstitution r+ return $! r+ PointerToType t' -> do+ tb <- showType t'+ let r = tb `mappend` singleton '*'+ recordSubstitution r+ return $! r+ ReferenceToType t' -> do+ tb <- showType t'+ let r = tb `mappend` singleton '&'+ recordSubstitution r+ return $! r+ RValueReferenceToType t' -> do+ tb <- showType t'+ let r = tb `mappend` fromString "&&"+ recordSubstitution r+ return $! 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"+ BoolType -> return $! fromString "bool"+ CharType -> return $! fromString "char"+ SignedCharType -> return $! fromString "signed char"+ UnsignedCharType -> return $! fromString "unsigned char"+ ShortType -> return $! fromString "short"+ UnsignedShortType -> return $! fromString "unsigned short"+ IntType -> return $! fromString "int"+ UnsignedIntType -> return $! fromString "unsigned int"+ LongType -> return $! fromString "long"+ UnsignedLongType -> return $! fromString "unsigned long"+ LongLongType -> return $! fromString "long long"+ UnsignedLongLongType -> return $! fromString "unsigned long long"+ Int128Type -> return $! fromString "__int128"+ UnsignedInt128Type -> return $! fromString "unsigned __int128"+ FloatType -> return $! fromString "float"+ DoubleType -> return $! fromString "double"+ LongDoubleType -> return $! fromString "long double"+ Float128Type -> return $! fromString "__float128"+ EllipsisType -> return $! fromString "..."+ Char32Type -> return $! fromString "char32_t"+ Char16Type -> return $! fromString "char16_t"+ AutoType -> return $! fromString "auto"+ NullPtrType -> return $! fromString "std::nullptr_t"+ VendorBuiltinType s -> return $! fromString s+ FunctionType _ -> error "Only pointers to function types are supported"+ 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+ PtrToMemberType c m -> do+ r <- showPtrToMember c m+ recordSubstitution r+ return $! r+ SubstitutionType s -> showSubstitution s++showSubstitution :: Substitution -> Pretty Builder+showSubstitution s =+ case s of+ Substitution ss -> getSubstitution ss+ SubStdNamespace -> return $! fromString "std"+ SubStdAllocator -> return $! fromString "std::allocator"+ SubBasicString -> return $! fromString "std::basic_string"+ SubBasicStringArgs -> return $! fromString "std::basic_string<char, std::char_traits<char>, std::allocator<char> >"+ SubBasicIstream -> return $! fromString "std::basic_istream<char, std::char_traits<char> >"+ 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+showPtrToMember (ClassEnumType n) (FunctionType (rt:argts)) = do+ rt' <- showType rt+ argts' <- mapM showType argts+ nb <- showName n+ return $! mconcat [ rt', fromString " (", nb , fromString "::*)("+ , mconcat (intersperse (fromString ", ") argts')+ , singleton ')'+ ]+showPtrToMember _ _ = error "Expected a ClassEnumType and FunctionType pair for PtrToMemberType"++showFunctionType :: [CXXType] -> Pretty Builder+showFunctionType ts =+ case ts of+ [] -> error "Empty type list in function type"+ [rtype, VoidType] -> do+ rt' <- showType rtype+ return $! mconcat [ rt', fromString " (*)()" ]+ rtype:rest -> do+ tb <- showType rtype+ rbs <- mapM showType rest+ let arglist = mconcat $ intersperse (fromString ", ") rbs+ return $! mconcat [ tb, fromString " (*)(", arglist, singleton ')' ]++-- Helpers++-- Taken from parsec-numbers+numberValue :: Integral i => Int -> String -> i+numberValue base =+ foldl' (\ x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0
+ src/ABI/Itanium/Types.hs view
@@ -0,0 +1,214 @@+{-# LANGUAGE DeriveDataTypeable #-}+module ABI.Itanium.Types (+ DecodedName(..),+ CVQualifier(..),+ CXXType(..),+ Name(..),+ Prefix(..),+ UnqualifiedName(..),+ UName(..),+ CtorDtor(..),+ Operator(..),+ Expression(..),+ CallOffset(..),+ Substitution(..),+ TemplateArg(..),+ TemplateParam(..)+ ) where++import Data.Data++data DecodedName = Function Name [CXXType]+ | Data Name+ | VirtualTable CXXType+ | VTTStructure CXXType+ | TypeInfo CXXType+ | TypeInfoName CXXType+ | GuardVariable Name+ | OverrideThunk CallOffset DecodedName+ | OverrideThunkCovariant CallOffset CallOffset DecodedName+ deriving (Eq, Ord, Show, Data, Typeable)++data CallOffset = VirtualOffset Int Int+ | NonVirtualOffset Int+ deriving (Eq, Ord, Show, Data, Typeable)++data CVQualifier = Restrict+ | Volatile+ | Const+ deriving (Eq, Ord, Show, Data, Typeable)++data Substitution = Substitution (Maybe String)+ | SubStdNamespace+ | SubStdAllocator+ | SubBasicString+ | SubBasicStringArgs+ | SubBasicIstream+ | SubBasicOstream+ | SubBasicIostream+ deriving (Eq, Ord, Show, Data, Typeable)++data CXXType = QualifiedType [CVQualifier] CXXType+ | PointerToType CXXType+ | ReferenceToType CXXType+ | RValueReferenceToType CXXType+ | ComplexPairType CXXType+ | ImaginaryType CXXType+ | ParameterPack CXXType+ -- | DeclTypeExpression <expression>+ -- | DeclTypeOther <expression>+ | VendorTypeQualifier String CXXType+ | VoidType+ | Wchar_tType+ | BoolType+ | CharType+ | SignedCharType+ | UnsignedCharType+ | ShortType+ | UnsignedShortType+ | IntType+ | UnsignedIntType+ | LongType+ | UnsignedLongType+ | LongLongType+ | UnsignedLongLongType+ | Int128Type+ | UnsignedInt128Type+ | FloatType+ | DoubleType+ | LongDoubleType+ | Float128Type+ | EllipsisType+ -- There are also four IEEE 754r types and I don't know what that is+ | Char32Type+ | Char16Type+ | AutoType+ | NullPtrType+ | VendorBuiltinType String+ | FunctionType [CXXType]+ | ExternCFunctionType [CXXType]+ | ArrayTypeN (Maybe Int) CXXType+ -- ^ int[5], normal array parameters. The dimension is+ -- elided for C99 VLAs+ | ArrayTypeE Expression+ -- ^ int[I + 1], expresions due to templates. The+ -- dimension is not optional here; if it was it would+ -- just be an ArrayTypeN+ | PtrToMemberType CXXType CXXType+ -- ^ Class type, member type+ | ClassEnumType Name+ | SubstitutionType Substitution+ | TemplateParamType TemplateParam+ | TemplateTemplateParamType TemplateParam [TemplateArg]+ | TemplateTemplateParamSubstitutionType Substitution [TemplateArg]+ deriving (Eq, Ord, Show, Data, Typeable)++data Expression = Expression+ deriving (Eq, Ord, Show, Data, Typeable)++data Name = NestedName [CVQualifier] [Prefix] UnqualifiedName+ | NestedTemplateName [CVQualifier] [Prefix] [TemplateArg]+ | UnscopedName UName+ | UnscopedTemplateName UName [TemplateArg]+ | UnscopedTemplateSubstitution Substitution [TemplateArg]+ -- Still need local-name+ deriving (Eq, Ord, Show, Data, Typeable)++data UName = UName UnqualifiedName+ | UStdName UnqualifiedName+ deriving (Eq, Ord, Show, Data, Typeable)++{-+<prefix> ::= <prefix> <unqualified-name>+ ::= <template-prefix> <template-args>+ ::= <template-param>+ ::= <decltype>+ ::= # empty+ ::= <substitution>+ ::= <prefix> <data-member-prefix>++<data-member-prefix> := <member source-name> M++This is currently massively incomplete+-}+data Prefix = DataMemberPrefix String+ | UnqualifiedPrefix UnqualifiedName+ | SubstitutionPrefix Substitution+ | TemplateParamPrefix TemplateParam+ | TemplateArgsPrefix [TemplateArg]+ deriving (Eq, Ord, Show, Data, Typeable)++data TemplateArg = TypeTemplateArg CXXType+ deriving (Eq, Ord, Show, Data, Typeable)++data TemplateParam = TemplateParam (Maybe Int)+ deriving (Eq, Ord, Show, Data, Typeable)++data UnqualifiedName = OperatorName Operator+ | CtorDtorName CtorDtor+ | SourceName String+ -- UnnamedTypeName String+ deriving (Eq, Ord, Show, Data, Typeable)++data CtorDtor = C1 -- Complete object constructor+ | C2 -- Base object constructor+ | C3 -- Complete object allocating constructor+ | D0 -- Deleting destructor+ | D1 -- Complete object destructor+ | D2 -- Base object destructor+ deriving (Eq, Ord, Show, Data, Typeable)++data Operator = OpNew -- ^ new+ | OpNewArray -- ^ new[]+ | OpDelete -- ^ delete+ | OpDeleteArray -- ^ delete[]+ | OpUPlus -- ^ + (unary)+ | OpUMinus -- ^ - (unary)+ | OpAddressOf -- ^ & (unary)+ | OpDeref -- ^ * (unary)+ | OpBitNot -- ^ ~+ | OpPlus -- ^ ++ | OpMinus -- ^ -+ | OpMul -- ^ *+ | OpDiv -- ^ /+ | OpMod -- ^ %+ | OpBitAnd -- ^ &+ | OpBitOr -- ^ \|+ | OpBitXor -- ^ \^+ | OpAssign -- ^ =+ | OpPlusAssign+ | OpMinusAssign+ | OpMulAssign+ | OpDivAssign+ | OpModAssign+ | OpAndAssign+ | OpOrAssign+ | OpXorAssign+ | OpShl+ | OpShr+ | OpShlAssign+ | OpShrAssign+ | OpEquals+ | OpNotEquals+ | OpLt+ | OpGt+ | OpLte+ | OpGte+ | OpNot+ | OpAnd+ | OpOr+ | OpPlusPlus+ | OpMinusMinus+ | OpComma+ | OpArrowStar+ | OpArrow+ | OpCall+ | OpIndex+ | OpQuestion -- ? ??+ | OpSizeofType+ | OpSizeofExpr+ | OpAlignofType+ | OpAlignofExpr+ | OpCast CXXType+ | OpVendor Int String+ deriving (Eq, Ord, Show, Data, Typeable)
+ tests/DemangleTests.hs view
@@ -0,0 +1,25 @@+module Main ( main ) where++import qualified System.IO as IO+import System.Process+import Test.Framework ( defaultMain, testGroup, Test )+import Test.Framework.Providers.HUnit+import Test.HUnit hiding ( Test )++import ABI.Itanium++mkTestCase :: (String, String) -> Test+mkTestCase (sym, expected) = testCase sym $ do+ case demangleName sym of+ Left err -> assertFailure (sym ++ " : " ++ err)+ Right dname -> do+ let oracle = filter (/= '\n') expected+ assertEqual sym oracle (cxxNameToString dname)++main :: IO ()+main = do+ inputs <- IO.readFile "tests/test-cases.txt"+ expecteds <- readProcess "demangle" [] inputs+ let symbols = zip (lines inputs) (lines expecteds)+ tests = [ testGroup "QtGUI" (map mkTestCase symbols) ]+ defaultMain tests