diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/itanium-abi.cabal b/itanium-abi.cabal new file mode 100644 --- /dev/null +++ b/itanium-abi.cabal @@ -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 diff --git a/src/ABI/Itanium.hs b/src/ABI/Itanium.hs new file mode 100644 --- /dev/null +++ b/src/ABI/Itanium.hs @@ -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 production in the Itanium ABI spec +-- +-- FIXME: Add support for unnamed types and decltypes +-- +-- ::= Ut [ ] _ +-- ::= Dt E # decltype of an id-expression or class member access (C++0x) +-- ::= DT 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 ]) ] diff --git a/src/ABI/Itanium/Pretty.hs b/src/ABI/Itanium/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/ABI/Itanium/Pretty.hs @@ -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 "' ] + 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, std::allocator >" + SubBasicIstream -> return $! fromString "std::basic_istream >" + SubBasicOstream -> return $! fromString "std::basic_ostream >" + SubBasicIostream -> return $! fromString "std::basic_iostream >" + +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 diff --git a/src/ABI/Itanium/Types.hs b/src/ABI/Itanium/Types.hs new file mode 100644 --- /dev/null +++ b/src/ABI/Itanium/Types.hs @@ -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 + -- | DeclTypeOther + | 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) + +{- + ::= + ::= + ::= + ::= + ::= # empty + ::= + ::= + + := 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) diff --git a/tests/DemangleTests.hs b/tests/DemangleTests.hs new file mode 100644 --- /dev/null +++ b/tests/DemangleTests.hs @@ -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