demangler 1.2.0.0 → 1.3.2.0
raw patch · 13 files changed
+1198/−396 lines, 13 filesdep ~sayablePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: sayable
API changes (from Hackage documentation)
+ Demangler: functionName :: Result -> Maybe (NonEmpty Text)
Files
- CHANGELOG.md +26/−0
- demangler.cabal +6/−3
- src/Demangler.hs +213/−51
- src/Demangler/Accessors.hs +111/−0
- src/Demangler/Context.hs +27/−4
- src/Demangler/Engine.hs +5/−2
- src/Demangler/PPrint.hs +423/−211
- src/Demangler/Structure.hs +215/−97
- src/Demangler/Substitution.hs +65/−14
- test/Test.hs +28/−14
- test/full-test-cases.txt-funcnames +0/−0
- test/initial-test-cases.txt +15/−0
- test/initial-test-cases.txt-funcnames +64/−0
CHANGELOG.md view
@@ -1,5 +1,31 @@ # Revision history for demangler +## 1.3.2.0 -- 2023.04.22++* Fix handling of discriminators.+* Add handling for UnnamedTypeName unqualified names.+* Fix parsing of primary expressions in template parameters.+* Fully support DeclType elements.+* More complete implementation of function params.+* Fix parsing of reference qualifiers+* Suppress function argument output for template arguments.+* Allow extraction of function names with unnamed-type elements.+* Convert full ClassUnionStructEnum name to a substitutable prefix.+* Suppress any visible indication of empty template argument packs.+* Add C11 argument pack expansion support with template argument packs.+* Add support for pointer-to-member-type elements.+* Proper UnscopedName parsing for template parameters.+* Fixed order of CV qualifier parsing.++## 1.3.1.0 -- 2023.11.12++* Added support for demangling expressions.++## 1.3.0.0 -- 2023.11.09++* Added `functionName` accessor to retrieve the name portions only of a function+ (in reverse heirarchical order).+ ## 1.2.0.0 -- 2023.10.29 * Updated support for local names.
demangler.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: demangler-version: 1.2.0.0+version: 1.3.2.0 synopsis: Demangler for C++ mangled names. description: Provides a demangler (and mangler) for C++ names, with an intermediate@@ -23,7 +23,9 @@ README.org extra-source-files: test/initial-test-cases.txt+ test/initial-test-cases.txt-funcnames test/full-test-cases.txt+ test/full-test-cases.txt-funcnames tested-with: GHC == 8.8.4 , GHC == 8.10.7@@ -58,7 +60,8 @@ hs-source-dirs: src default-language: Haskell2010 exposed-modules: Demangler- other-modules: Demangler.Context+ other-modules: Demangler.Accessors+ Demangler.Context Demangler.Engine Demangler.PPrint Demangler.Structure@@ -66,7 +69,7 @@ build-depends: base >=4.10 && < 5 , containers , lens >= 5.0 && < 5.3- , sayable >= 1.2.3.0 && < 1.3+ , sayable >= 1.2.3.1 && < 1.3 , template-haskell , text if flag(debug)
src/Demangler.hs view
@@ -21,6 +21,7 @@ , Result , demangle , demangle1+ , functionName ) where @@ -37,6 +38,7 @@ import qualified Data.Text as T import Text.Sayable +import Demangler.Accessors import Demangler.Context import Demangler.Engine import Demangler.PPrint ()@@ -149,7 +151,7 @@ , unscoped_template_name >&=> template_args >=> rmap (uncurry UnscopedTemplateName) , local_name- , unscoped_name+ , unscoped_name >=> rmap UnscopedName ] nested_name :: AnyNext NestedName@@ -187,18 +189,16 @@ let (cvq, mb'refQual) = i ^. nVal ret pa $ NestedTemplateName p a cvq mb'refQual -unscoped_name :: AnyNext Name+unscoped_name :: AnyNext UnscopedName unscoped_name =- asum' [ unqualified_name >=> rmap (UnscopedName False)- , match "St" >=> unqualified_name >=> rmap (UnscopedName True)+ asum' [ unqualified_name >=> rmap (UnScName False)+ , match "St" >=> unqualified_name >=> rmap (UnScName True) ] unscoped_template_name :: AnyNext Name unscoped_template_name i =- (unscoped_name i >>= canSubstUnscopedTemplateName)- <|> (substitution i- >>= substituteUnqualifiedName (rmap StdSubst)- >>= rmap (UnscopedName False)+ (unscoped_name i >>= rmap UnscopedName >>= canSubstUnscopedTemplateName)+ <|> (substitution i >>= (rmap UnscopedName <=< substituteUnscopedName (rmap UnScSubst)) ) @@ -206,15 +206,10 @@ local_name = match "Z" >=> function_encoding >=> match "E"- >=> asum' [ match "s"- >=> rmap StringLitName- >=> optional' discriminator- >=> rmap (uncurry ($))- , rmap LocalName- >&=> name- >=> rmap (uncurry ($))- >=> optional' discriminator- >=> rmap (uncurry ($))+ >=> asum' [ match "s" >=> rmap StringLitName+ >=> optional' discriminator >=> rapply+ , rmap LocalName >&=> name >=> rapply+ >=> optional' discriminator >=> rapply ] @@ -224,13 +219,13 @@ cv_qualifiers = let ifPresent v i = rmap (\(a,p) -> if isJust p then v:a else a) i in insert []- >=> optional' (match "K") >=> ifPresent Const_- >=> optional' (match "V") >=> ifPresent Volatile >=> optional' (match "r") >=> ifPresent Restrict+ >=> optional' (match "V") >=> ifPresent Volatile+ >=> optional' (match "K") >=> ifPresent Const_ ref_qualifier :: AnyNext RefQualifier-ref_qualifier = asum' [ match "&&" >=> rmap (const RefRef)- , match "&" >=> rmap (const Ref)+ref_qualifier = asum' [ match "O" >=> rmap (const RefRef)+ , match "R" >=> rmap (const Ref) ] -- | Parse prefix. This is a bit tricky though. The BNF specifies:@@ -321,12 +316,12 @@ substitutionPrefixR = rmap (($ PrefixEnd) . PrefixUQName . StdSubst) decltype :: AnyNext DeclType-decltype = asum' [ match "Dt" >=> expression >=> match "E" >=> tbd "decltype1"- , match "DT" >=> expression >=> match "E" >=> tbd "decltype2"+decltype = asum' [ match "Dt" >=> expression >=> match "E" >=> rmap DeclType+ , match "DT" >=> expression >=> match "E" >=> rmap DeclTypeExpr ] -closure_prefix :: AnyNext ClosurePrefix-closure_prefix = tbd "closure prefix"+-- closure_prefix :: AnyNext ClosurePrefix+-- closure_prefix = tbd "closure prefix" unqualified_name :: AnyNext UnqualifiedName unqualified_name =@@ -345,6 +340,7 @@ , source_name >&=> many' abi_tag . rdiscard >=> rmap (uncurry SourceName) , unnamed_type_name+ -- , match "DC" i >>= some source_name >>= match "E" ] @@ -356,7 +352,7 @@ operator_name :: AnyNext Operator operator_name =- let opMatch (o,(t,_)) = match t >=> rmap (const o)+ let opMatch (o,(_,(t,_))) = match t >=> rmap (const o) in asum' ((opMatch <$> opTable) <> [ match "cv" >=> type_ >=> rmap OpCast , match "li" >=> source_name >=> rmap OpString@@ -396,7 +392,11 @@ unnamed_type_name :: AnyNext UnqualifiedName-unnamed_type_name = tbd "unnamed_type_name"+unnamed_type_name = match "Ut"+ >=> ret' UnnamedTypeName+ >=> optional' digits_num >=> rmap (fmap $ fmap toEnum)+ >=> rapply+ >=> match "_" -- | Parse the function argument (and return) types for a function. --@@ -429,13 +429,13 @@ Nothing -> cannot Demangler "bare_function_type.withRetType" [ "Function with rtype and no argtypes: "- , sez @"error" (WC (i ^. nVal) (i ^. nContext))+ , sez @"error" (addContext (i ^. nVal) (i ^. nContext)) ] let noRetType = rmap (constr (i ^. nVal) Nothing) tys case i ^. nVal of FunctionName (UnscopedTemplateName- (UnscopedName _ (OperatorName (OpCast {}) _)) _) -> noRetType+ (UnscopedName (UnScName _ (OperatorName (OpCast {}) _))) _) -> noRetType FunctionName (UnscopedTemplateName {}) -> withRetType FunctionName (NameNested (NestedTemplateName pr _ _ _)) -> case pr of@@ -482,24 +482,24 @@ rmap ((:|[]) . BaseType) <=< builtin_type -- Single element matches- , asum' [ qualified_type- , function_type+ , asum' [ function_type , class_enum_type , array_type- -- , pointer_to_member_type+ , pointer_to_member_type , template_template_param >&=> template_args >=> rmap (uncurry Template)- -- , decltype+ , decltype >=> rmap DeclType_ -- This one is tricky: it's recursive, but then binds the -- (possibly) multiple returned recursion types into a single -- type.- , match "Dp" >=> type_parser >=> rmap Cpp11PackExpansion+ , match "Dp" >=> types_ >=> rmap Cpp11PackExpansion ] >=> canSubstType >=> rmap (:|[]) -- Possibly multiple element matches (either direct or via recursion)- , asum' [ match "P" >=> type_parser >=> rmap (fmap Pointer)+ , asum' [ qualified_type+ , match "P" >=> type_parser >=> rmap (fmap Pointer) , match "R" >=> type_parser >=> rmap (fmap LValRef) , match "O" >=> type_parser >=> rmap (fmap RValRef) , match "C" >=> type_parser >=> rmap (fmap ComplexPair)@@ -521,7 +521,7 @@ in ret i =<< NEL.nonEmpty (each <$> tas) o -> cannot Demangler "type_parser.template_param" [ "bad template param ref in type:"- , sez @"debug" (WC o (i ^. nContext))+ , sez @"debug" (addContext o (i ^. nContext)) , "raw: " <> show o ] )@@ -550,21 +550,24 @@ ] ) -qualified_type :: AnyNext Type_+-- Returns potentially multiple types to support C++11 argument packs+qualified_type :: AnyNext (NEL.NonEmpty Type_) qualified_type i = do eQ <- many' extended_qualifier $ rdiscard i cQ <- cv_qualifiers eQ -- Require some amount of production before recursion require $ not $ and [ null $ cQ ^. nVal , null $ eQ ^. nVal ]- tY <- type_ cQ- ret tY $ QualifiedType (eQ ^. nVal) (cQ ^. nVal) (tY ^. nVal)+ tYs <- type_parser cQ+ let eQv = eQ ^. nVal+ let cQv = cQ ^. nVal+ let qTy = QualifiedType eQv cQv+ ret tYs (qTy <$> (tYs ^. nVal)) extended_qualifier :: Next () ExtendedQualifier-extended_qualifier = tbd "extended_qualifier"+extended_qualifier = match "U" >=> tbd "extended_qualifier" function_type :: AnyNext Type_--- function_type = tbd "function_type" function_type i = do f0 <- cv_qualifiers i >>= optional' exception_spec >>= optional' (match "Dx")@@ -606,6 +609,11 @@ >=> rmap (uncurry (ArrayType . ExprBound)) ] +pointer_to_member_type :: AnyNext Type_+pointer_to_member_type = match "M"+ >=> type_ >=> rmap PointerToMember+ >&=> type_ >=> rapply+ function_encoding :: AnyNext Encoding function_encoding i = do e <- encoding i require $ case e ^. nVal of@@ -614,10 +622,11 @@ _ -> False return e -discriminator :: Next a Int+discriminator :: Next a Discriminator discriminator = asum' [ match "_" >=> single_digit_num , match "__" >=> digits_num >=> match "_" ]+ >=> rmap (Discriminator . toEnum) template_prefix_and_args :: AnyNext (TemplatePrefix, Maybe TemplateArgs) template_prefix_and_args =@@ -701,9 +710,12 @@ template_arg :: AnyNext TemplateArg template_arg =- asum' [ type_ >=> rmap TArgType >=> canSubstTemplateArg+ -- n.b. must check expr_primary ('L') before type_ because type_ can be a class+ -- name, which can be a name, which can be an unqualified name, which can be a+ -- "[module_name] L ..."+ asum' [ expr_primary >=> rmap TArgSimpleExpr >=> canSubstTemplateArg+ , type_ >=> rmap TArgType >=> canSubstTemplateArg , match "X" >=> expression >=> match "E" >=> rmap TArgExpr- , expression_primary >=> rmap TArgSimpleExpr >=> canSubstTemplateArg , match "J" >=> (\i -> do let locked = i ^. nTmplSubsLock r <- many' template_arg . rdiscard $ i & nTmplSubsLock .~ True@@ -721,14 +733,97 @@ >=> substituteTemplateParam expression :: AnyNext Expression-expression = asum' [ match "sp" >=> expression >=> rmap ExprPack- , template_param >=> rmap ExprTemplateParam- , expression_primary >=> rmap ExprPrim- , tbd "expression"- ]+expression =+ let opMatch (o,(Unary,(t,_))) = match t >=> expression >=> rmap (ExprUnary o)+ opMatch (o,(Binary,(t,_))) = match t >=> expression+ >=> rmap (ExprBinary o) >&=> expression+ >=> rapply+ opMatch (o,(Trinary,(t,_))) = match t >=> expression+ >=> rmap (ExprTrinary o) >&=> expression+ >=> rapply >&=> expression+ >=> rapply+ opMatch _ = const Nothing+ binary_op = operator_name+ >=> \i -> case lookup (i^.nVal) opTable of+ Just (Binary, _) -> pure i+ _ -> Nothing+ unary_op = operator_name+ >=> \i -> case lookup (i^.nVal) opTable of+ Just (Unary, _) -> pure i+ _ -> Nothing+ rmap2 = rmap . uncurry+ isGS = isJust . snd+ in asum'+ ((opMatch <$> opTable)+ <>+ [ match "pp_" >=> expression >=> rmap ExprPfxPlus+ , match "mm_" >=> expression >=> rmap ExprPfxMinus+ , match "cl" >=> some' expression >=> rmap ExprCall+ , match "cv" >=> type_ >&=> expression+ >=> match "E" -- n.b. missing from https://itanium-cxx-abi.github.io+ >=> rmap2 ExprConvert1+ , match "cv" >=> type_ >=> match "_" >&=> some' expression+ >=> rmap2 ExprConvertSome+ , match "tl" >=> type_ >&=> many' braced_expression . rdiscard+ >=> match "E" >=> rmap2 ExprConvertInit+ , match "il" >=> many' braced_expression . rdiscard >=> rmap ExprBracedInit+ , optional' (match "gs") >=> match "nw"+ >&=> many' expression . rdiscard+ >=> match "_" >&=> type_ >=> match "E"+ >=> rmap2 (uncurry (ExprNew . isGS))+ , optional' (match "gs") >=> match "nw" >=> rmap (ExprNewInit . isGS)+ >&=> many' expression . rdiscard+ >=> match "_" >&=> type_ >&=> initializer+ >=> rmap2 (uncurry (uncurry ($)))+ , optional' (match "gs") >=> match "na"+ >&=> many' expression . rdiscard+ >=> match "_" >&=> type_ >=> match "E"+ >=> rmap2 (uncurry (ExprNewArray . isGS))+ , optional' (match "gs") >=> match "na" >=> rmap (ExprNewInitArray . isGS)+ >&=> many' expression . rdiscard+ >=> match "_" >&=> type_ >&=> initializer+ >=> rmap2 (uncurry (uncurry ($)))+ , optional' (match "gs") >=> match "dl" >&=> expression+ >=> rmap2 (ExprDel . isGS)+ , optional' (match "gs") >=> match "da" >&=> expression+ >=> rmap2 (ExprDelArray . isGS)+ , match "dc" >=> type_ >&=> expression >=> rmap2 ExprDynamicCast+ , match "sc" >=> type_ >&=> expression >=> rmap2 ExprStaticCast+ , match "cc" >=> type_ >&=> expression >=> rmap2 ExprConstCast+ , match "rc" >=> type_ >&=> expression >=> rmap2 ExprReinterpretCast+ , match "ti" >=> type_ >=> rmap ExprTypeIdType+ , match "te" >=> expression >=> rmap ExprTypeId+ , match "st" >=> type_ >=> rmap ExprSizeOfType+ , match "sz" >=> expression >=> rmap ExprSizeOf+ , match "at" >=> type_ >=> rmap ExprAlignOfType+ , match "az" >=> expression >=> rmap ExprAlignOf+ , match "nx" >=> expression >=> rmap ExprNoException+ , template_param >=> rmap ExprTemplateParam+ , function_param >=> rmap ExprFunctionParam+ , match "dt" >=> expression >&=> unresolved_name >=> rmap2 ExprField+ , match "pt" >=> expression >&=> unresolved_name >=> rmap2 ExprFieldPtr+ , match "ds" >=> expression >&=> expression >=> rmap2 ExprFieldExpr+ , match "sZ" >=> template_param >=> rmap ExprSizeOfTmplParamPack+ , match "sZ" >=> function_param >=> rmap ExprSizeOfFuncParamPack+ , match "sP" >=> many' template_arg . rdiscard >=> match "E"+ >=> rmap ExprSizeOfCapturedTmplParamPack+ , match "sp" >=> expression >=> rmap ExprPack+ , match "fl" >=> unary_op >&=> expression >=> rmap2 ExprUnaryLeftFold+ , match "fr" >=> unary_op >&=> expression >=> rmap2 ExprUnaryRightFold+ , match "fL" >=> binary_op >&=> expression >=> rmap2 ExprBinaryLeftFold+ >&=> expression >=> rapply+ , match "fR" >=> binary_op >&=> expression >=> rmap2 ExprBinaryRightFold+ >&=> expression >=> rapply+ , match "tw" >=> expression >=> rmap ExprThrow+ , match "tr" >=> ret' ExprReThrow+ , match "u" >=> source_name >&=> many' template_arg . rdiscard+ >=> rmap2 ExprVendorExtended+ , unresolved_name >=> rmap ExprUnresolvedName+ , expr_primary >=> rmap ExprPrim+ ]) -expression_primary :: AnyNext ExprPrimary-expression_primary =+expr_primary :: AnyNext ExprPrimary+expr_primary = let toFloat w f = read (show w <> "." <> show f) floatLit ty w p = FloatLit (ty ^. nVal) $ toFloat (w ^.nVal) p complexLit ty w p iw ip =@@ -751,3 +846,70 @@ >=> asum' [ type_ >=> withType >=> match "E" , match "_Z" >=> encoding >=> match "E" >=> rmap ExternalNameLit ]++braced_expression :: AnyNext BracedExpression+braced_expression = asum' [ expression >=> rmap BracedExpr+ , match "di" >=> source_name >&=> braced_expression+ >=> rmap (uncurry BracedFieldExpr)+ , match "dx" >=> expression >&=> braced_expression+ >=> rmap (uncurry BracedIndexExpr)+ , match "dX" >=> expression >&=> expression+ >=> rmap (uncurry BracedRangedExpr)+ >&=> braced_expression >=> rapply+ ]++initializer :: AnyNext InitializerExpr+initializer = match "pi" >=> many' expression . rdiscard >=> match "E"+ >=> rmap Initializer++function_param :: AnyNext FunctionParam+function_param = asum' [ match "fpT" >=> rmap (const FP_This)+ , match "fp" >=> cv_qualifiers >=> rmap FP_+ >=> match "_" >=> rmap ($ 1)+ , match "fp" >=> cv_qualifiers >=> rmap FP_+ >&=> (digits_num >=> rmap (toEnum . (+2)))+ >=> match "_" >=> rapply+ , match "fL" >=> tbd "function param l"+ ]++unresolved_name :: AnyNext UnresolvedName+unresolved_name =+ asum' [ optional' (match "gs")+ >&=> base_unresolved_name+ >=> rmap (uncurry (URN_Base . isJust . snd))+ , match "sr" >=> unresolved_type >&=> base_unresolved_name+ >=> rmap (uncurry URNScopedRef)+ , match "srN" >=> unresolved_type >=> rmap URNSubScopedRef+ >&=> some' unresolved_qualifier_level >=> match "E" >=> rapply+ >&=> base_unresolved_name >=> rapply+ , optional' (match "gs")+ >&=> match "sr" >=> rmap (URNQualRef . isJust . snd . fst)+ >&=> some' unresolved_qualifier_level >=> match "E" >=> rapply+ >&=> base_unresolved_name >=> rapply+ ]++base_unresolved_name :: AnyNext BaseUnresolvedName+base_unresolved_name =+ asum' [ source_name >=> optional' template_args >=> rmap (uncurry BUName)+ , match "on" >=> operator_name >&=> template_args+ >=> rmap (uncurry BUOnOperatorT)+ , match "on" >=> operator_name >=> rmap BUOnOperator+ , match "dn" >=> asum' [ unresolved_type+ >=> rmap BUDestructorUnresolvedType+ , source_name >=> optional' template_args+ >=> rmap (uncurry BUDestructorSimpleId)+ ]+ ]++unresolved_type :: AnyNext UnresolvedType+unresolved_type i =+ (asum' [ template_param >=> optional' template_args >=> rmap (uncurry URTTemplate)+ , decltype >=> rmap URTDeclType+ ]+ i >>= canSubstUnresolvedType)+ <|> (substitution i+ >>= substituteUnresolvedType (tbd "substituteUnresolvedType"))++unresolved_qualifier_level :: AnyNext UnresolvedQualifierLevel+unresolved_qualifier_level =+ source_name >=> optional' template_args >=> rmap (uncurry URQL)
+ src/Demangler/Accessors.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Demangler.Accessors+ (+ functionName+ )+where++import Data.List.NonEmpty ( NonEmpty( (:|) ) )+import qualified Data.List.NonEmpty as NEL+import Data.Text ( Text )+import qualified Data.Text as T++import Demangler.Context+import Demangler.Engine+import Demangler.Structure+++-- | Returns the base function name. This is the core text name for the function+-- (C-style) followed by the parent class/namespace (innermost-to-outermost) but+-- without any argument and template information and therefore it is not+-- necessarily unique. The parent names have any template information removed as+-- well. For example:+--+-- @std::map<int, char>::insert(...)@ returns @"insert" :| [ "map", "std" ]@+--+-- The reason for the reversed form is that the base name is usually the most+-- relevant, and the parent information can be optionally consumed (and lazily+-- generated) as needed.+--+-- If the name could not be demangled, the non-demangled form is returned+-- (perhaps it is a plain function name already?).+--+-- If the demangled name is not a function (e.g. a data or special name) then+-- Nothing is returned.++functionName :: Result -> Maybe (NEL.NonEmpty Text)+functionName (d,c) =+ case d of+ Original i -> Just $ contextStr (addContext () c) i :| []+ Encoded e -> resolveCtorDtor <$> getEnc e+ VendorExtended e _ -> getEnc e+ where+ resolveCtorDtor = \case+ ("{{CTOR}" :| r@(nm : nm2 : _)) | "unnamed_type_num" `T.isPrefixOf` nm -> nm2 :| r+ ("{{DTOR}" :| r@(nm : nm2 : _)) | "unnamed_type_num" `T.isPrefixOf` nm -> "~" <> nm2 :| r+ ("{{CTOR}" :| r@(nm : _)) -> nm :| r+ ("{{DTOR}" :| r@(nm : _)) -> "~" <> nm :| r+ o -> o+ getEnc = \case+ EncFunc (FunctionName fn) _rty _argtys -> getName fn+ EncStaticFunc (FunctionName fn) _rty _argtys -> getName fn+ EncData (LocalName enc _ _) -> getEnc enc+ _ -> Nothing+ getName = \case+ UnscopedName usn -> getUSN usn+ UnscopedTemplateName nm _tmplArgs -> getName nm+ NameNested nnm -> getNestedNm nnm+ nm -> Just $ T.pack ( show nm ) :| []+ getUSN = \case+ UnScName False uqn -> Just $ NEL.fromList $ getUQN uqn+ UnScName True uqn -> Just $ NEL.fromList $ getUQN uqn <> ["std"]+ UnScSubst subs -> Just $ NEL.fromList $ getStdSubst subs+ getUQN = \case+ SourceName (SrcName i) _ -> [contextStr (addContext () c) i]+ OperatorName op _ ->+ [maybe (T.pack $ show op) (("operator" <>) . snd . snd)+ $ lookup op opTable]+ CtorDtorName ctd -> case ctd of+ CompleteCtor -> ["{{CTOR}"]+ BaseCtor -> ["{{CTOR}"]+ CompleteAllocatingCtor -> ["{{CTOR}"]+ CompleteInheritingCtor _ -> ["{{CTOR}"]+ BaseInheritingCtor _ -> ["{{CTOR}"]+ DeletingDtor -> ["{{DTOR}"]+ CompleteDtor -> ["{{DTOR}"]+ BaseDtor -> ["{{DTOR}"]+ StdSubst sbst -> getStdSubst sbst+ ModuleNamed _ uqn -> getUQN uqn+ UnnamedTypeName mbnum ->+ -- Highly unusual, and probably not ultimately useful. This happens when+ -- an unnamed structure/union/class has a function. For example,+ -- "_ZN3FooUt3_C2Ev" translates to "Foo::{unnamed type#5}::Foo()".+ let n = maybe 1 (+2) mbnum in [ T.pack $ "unnamed_type_num" <> show n ]+ getStdSubst = \case+ SubStd -> ["std"]+ SubAlloc -> [ "allocator", "std" ]+ SubBasicString -> [ "basic_string", "std" ]+ SubStdType BasicStringChar -> [ "string", "std" ]+ SubStdType BasicIStream -> [ "istream", "std" ]+ SubStdType BasicOStream -> [ "ostream", "std" ]+ SubStdType BasicIOStream -> [ "iostream", "std" ]+ getNestedNm = \case+ NestedName pfx uqn _ _ -> NEL.nonEmpty $ getUQN uqn <> getPfx pfx+ NestedTemplateName tmplpfx _tmplArgs _ _ -> NEL.nonEmpty $ getTmplPfx tmplpfx+ getPfx = \case+ PrefixTemplateParam _tmplParam r -> getPfxR r+ PrefixDeclType _dclTy r -> getPfxR r+ PrefixClosure _ -> []+ Prefix r -> getPfxR r+ getPfxR = \case+ PrefixUQName uqn r -> getPfxR r <> getUQN uqn+ PrefixTemplateArgs _ r -> getPfxR r+ PrefixEnd -> []+ getTmplPfx = \case+ GlobalTemplate uqns -> foldr ((<>) . getUQN) [] uqns+ NestedTemplate pfx uqns -> foldr ((<>) . getUQN) (getPfx pfx) uqns+ TemplateTemplateParam _ -> []
src/Demangler/Context.hs view
@@ -6,7 +6,12 @@ , newDemangling , contextFindOrAdd , contextStr- , WithContext(..)+ , WithContext+ , addContext+ , withContext+ , contextData+ , withContextForTemplateArg+ , isTemplateArgContext , sayableConstraints ) where@@ -46,10 +51,28 @@ Just n -> (n, c) Nothing -> (Seq.length l, Context $ l |> s) -contextStr :: Context -> Coord -> Text-contextStr (Context l) i = l `Seq.index` i+contextStr :: WithContext a -> Coord -> Text+contextStr (WC _ _ (Context l)) i = l `Seq.index` i -data WithContext a = WC a Context+data SayingElement = DefaultSay | SayingTemplateArg++data WithContext a = WC SayingElement a Context++addContext :: a -> Context -> WithContext a+addContext = WC DefaultSay++withContext :: WithContext a -> b -> WithContext b+withContext (WC s _ c) d = WC s d c++withContextForTemplateArg :: WithContext a -> b -> WithContext b+withContextForTemplateArg (WC _ _ c) d = WC SayingTemplateArg d c++isTemplateArgContext :: WithContext a -> Bool+isTemplateArgContext (WC SayingTemplateArg _ _) = True+isTemplateArgContext _ = False++contextData :: WithContext a -> a+contextData (WC _ d _) = d sayableConstraints :: TH.Name -> TH.PredQ sayableConstraints forTy = do
src/Demangler/Engine.hs view
@@ -29,7 +29,7 @@ instance PanicComponent Demangler where panicComponentName _ = "Demangler"- panicComponentIssues = const "https://github.com/galoisinc/demangler/issues"+ panicComponentIssues = const "https://github.com/GaloisInc/demangler/issues" panicComponentRevision _ = ("main", "-") cannot :: PanicComponent a => a -> String -> [String] -> b@@ -89,7 +89,10 @@ rmap :: Applicative f => (a -> b) -> NextArg a -> f (NextArg b) rmap f i = ret i $ f (i ^. nVal) +rapply :: Applicative f => NextArg (a -> b, a) -> f (NextArg b)+rapply = rmap $ uncurry ($) + -------------------- -- Helpers @@ -165,7 +168,7 @@ a >&=> b = \i -> do x <- a i y <- b x rmap ((x ^. nVal,)) y-infix 2 >&=>+infixl 2 >&=> insert :: b -> Next a b insert v = pure . (nVal .~ v)
src/Demangler/PPrint.hs view
@@ -17,6 +17,7 @@ module Demangler.PPrint () where +import Control.Applicative import Data.Char import Data.List.NonEmpty ( NonEmpty((:|)) ) import qualified Data.List.NonEmpty as NEL@@ -54,21 +55,21 @@ $(return []) -ctxLst :: forall saytag t a .+ctxLst :: forall saytag t a b . Sayable saytag (WithContext a) => Functor t => Foldable t- => t a -> Context -> Saying saytag-ctxLst l c = t'"" &+* wCtx l c+ => t a -> WithContext b -> Saying saytag+ctxLst l wc = t'"" &+* wCtx l wc ctxLst' :: Sayable saytag (WithContext a) => Functor t => Foldable t- => t a -> Context -> Text -> Saying saytag-ctxLst' l c sep = sep &:* wCtx l c+ => t a -> WithContext b -> Text -> Saying saytag+ctxLst' l wc sep = sep &:* wCtx l wc -wCtx :: Functor t => t a -> Context -> t (WithContext a)-wCtx a c = (\b -> WC b c) <$> a+wCtx :: Functor t => t a -> WithContext b -> t (WithContext a)+wCtx a wc = withContext wc <$> a ----------------------------------------------------------------------@@ -78,27 +79,27 @@ ( Sayable "diagnostic" (WithContext Encoding) ) => Sayable "diagnostic" Result where sayable = \case- (Original i, c) -> contextStr c i &- t'"{orig}"- (Encoded e, c) -> sayable @"diagnostic" $ WC e c+ (Original i, c) -> contextStr (addContext () c) i &- t'"{orig}"+ (Encoded e, c) -> sayable @"diagnostic" $ addContext e c (VendorExtended d i, c) ->- let (s1,s2) = T.span isAlphaNum $ contextStr c i- in WC d c &- t'"[clone" &- s1 &+ ']' &+ s2+ let (s1,s2) = T.span isAlphaNum $ contextStr (addContext () c) i+ in addContext d c &- t'"[clone" &- s1 &+ ']' &+ s2 instance {-# OVERLAPPABLE #-} ( Sayable saytag (WithContext Encoding) ) => Sayable saytag Result where sayable = \case- (Original i, c) -> sayable @saytag $ contextStr c i- (Encoded e, c) -> sayable @saytag $ WC e c+ (Original i, c) -> sayable @saytag $ contextStr (addContext () c) i+ (Encoded e, c) -> sayable @saytag $ addContext e c (VendorExtended d i, c) ->- let (s1,s2) = T.span isAlphaNum $ contextStr c i- in WC d c &- t'"[clone" &- '.' &+ s1 &+ ']' &+ s2+ let (s1,s2) = T.span isAlphaNum $ contextStr (addContext () c) i+ in addContext d c &- t'"[clone" &- '.' &+ s1 &+ ']' &+ s2 instance {-# OVERLAPPABLE #-} $(sayableConstraints ''Encoding ) => Sayable saytag (WithContext Encoding) where- sayable (WC n c) =- case n of+ sayable wc =+ case contextData wc of -- Note: if the function has only a single void argument, print "()" -- instead of "(void)"; these are semantically the same, but demangling -- emits the former.@@ -106,25 +107,32 @@ -- Another tricky part is that the FunctionName may contain qualifiers -- (esp. "const") but for a function these must be placed at the end, -- following the arguments.- EncFunc f rty (BaseType Void :| []) -> sayFunction c f rty []- EncFunc f rty t -> sayFunction c f rty $ NEL.toList t+ --+ -- Additionally, if this function is being printed as part of a template+ -- argument, then do not print the arguments. This conforms to GCC c++filt+ -- output, although llvm-cxxfilt *does* print the arguments, however, the+ -- testing oracle is c++filt.+ EncFunc f rty (BaseType Void :| []) -> sayFunction wc f rty []+ EncFunc f rty t -> sayFunction wc f rty $ NEL.toList t -- n.b. static functions don't have any visible difference in demangled -- form.- EncStaticFunc f rty (BaseType Void :| []) -> sayFunction c f rty []- EncStaticFunc f rty t -> sayFunction c f rty $ NEL.toList t- EncConstStructData nm -> sayable @saytag $ WC nm c- EncData nm -> sayable @saytag $ WC nm c- EncSpecial sn -> sayable @saytag $ WC sn c+ EncStaticFunc f rty (BaseType Void :| []) -> sayFunction wc f rty []+ EncStaticFunc f rty t -> sayFunction wc f rty $ NEL.toList t+ EncConstStructData nm -> sayable @saytag $ withContext wc nm+ EncData nm -> sayable @saytag $ withContext wc nm+ EncSpecial sn -> sayable @saytag $ withContext wc sn sayFunction :: Sayable saytag (WithContext Type_)- => Context -> FunctionName -> Maybe Type_ -> [Type_] -> Saying saytag-sayFunction c fn mbRet args =+ => WithContext a -> FunctionName -> Maybe Type_ -> [Type_] -> Saying saytag+sayFunction wc fn mbRet args = let (nm,q) = cleanFunctionName fn part1 = case mbRet of- Nothing -> WC nm c &+ t'""- Just rty -> WC rty c &- WC nm c- part2 = part1 &+ '(' &+ ctxLst args c &+ ')'- in if null q then part2 else part2 &- ctxLst' q c " "+ Nothing -> withContext wc nm &+ t'""+ Just rty -> withContext wc rty &- withContext wc nm+ part2 = if isTemplateArgContext wc+ then part1+ else part1 &+ '(' &+ ctxLst args wc &+ ')'+ in if null q then part2 else part2 &- ctxLst' q wc " " instance Sayable saytag (WithContext a) => Sayable saytag (NonEmpty (WithContext a)) where@@ -132,7 +140,7 @@ instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext a) => Sayable saytag (WithContext (NonEmpty a)) where- sayable (WC l c) = ctxLst l c+ sayable wc = ctxLst (contextData wc) wc cleanFunctionName :: FunctionName -> (Name, [CVQualifier]) cleanFunctionName (FunctionName nm) =@@ -146,132 +154,178 @@ instance {-# OVERLAPPABLE #-} $(sayableConstraints ''SpecialName ) => Sayable saytag (WithContext SpecialName) where- sayable (WC n c) =- case n of- VirtualTable ty -> t'"vtable for" &- WC ty c- TemplateParameterObj ta -> t'"template parameter object for" &- WC ta c- VTT ty -> t'"VTT for" &- WC ty c- TypeInfo ty -> t'"typeinfo for" &- WC ty c- TypeInfoName ty -> t'"typeinfo name for" &- WC ty c+ sayable wc =+ case contextData wc of+ VirtualTable ty -> t'"vtable for" &- withContext wc ty+ TemplateParameterObj ta -> t'"template parameter object for" &- withContext wc ta+ VTT ty -> t'"VTT for" &- withContext wc ty+ TypeInfo ty -> t'"typeinfo for" &- withContext wc ty+ TypeInfoName ty -> t'"typeinfo name for" &- withContext wc ty CtorVTable _ -> t'"construction vtable for" &- t'"()"- Thunk (VirtualOffset _o1 _o2) enc -> t'"virtual thunk to" &- WC enc c- Thunk (NonVirtualOffset _o1) enc -> t'"non-virtual thunk to" &- WC enc c+ Thunk (VirtualOffset _o1 _o2) enc -> t'"virtual thunk to" &- withContext wc enc+ Thunk (NonVirtualOffset _o1) enc -> t'"non-virtual thunk to" &- withContext wc enc instance {-# OVERLAPPABLE #-} $(sayableConstraints ''FunctionName ) => Sayable saytag (WithContext FunctionName) where- sayable (WC n c) = sayable @saytag $ WC n c+ sayable wc = let FunctionName n = contextData wc+ in sayable @saytag $ withContext wc n instance {-# OVERLAPPABLE #-} $(sayableConstraints ''Name ) => Sayable saytag (WithContext Name) where- sayable (WC n c) =- case n of- NameNested nn -> sayable @saytag $ WC nn c- UnscopedName False uqn -> sayable @saytag $ WC uqn c- UnscopedName True uqn -> t'"std::" &+ WC uqn c- UnscopedTemplateName nn ta -> WC nn c &+ WC ta c- LocalName fs fe mbd -> WC fs c &+ t'"::" &+ WC fe c &? wCtx mbd c -- ??- StringLitName fs mbd -> WC fs c &? wCtx mbd c -- ??+ sayable wc =+ case contextData wc of+ NameNested nn -> sayable @saytag $ withContext wc nn+ UnscopedName usn -> sayable @saytag $ withContext wc usn+ UnscopedTemplateName nn ta -> withContext wc nn &+ withContext wc ta+ LocalName fs fe _discr -> withContext wc fs &+ t'"::" &+ withContext wc fe -- Discriminators are invisible in demangled form+ StringLitName fs _discr -> sayable @saytag $ withContext wc fs -- Discriminators are invisible in demangled form +-- Note: this should never actually be used, but the sayableConstraints template+-- haskell production doesn't know that.+instance Sayable saytag Discriminator where+ sayable _ = sayable @saytag $ t'""+instance Sayable saytag (WithContext Discriminator) where+ sayable _ = sayable @saytag $ t'""++instance {--# OVERLAPPABLE #-}+ $(sayableConstraints ''UnscopedName+ ) => Sayable saytag (WithContext UnscopedName) where+ sayable wc =+ case contextData wc of+ UnScName False uqn -> sayable @saytag $ withContext wc uqn+ UnScName True uqn -> t'"std::" &+ withContext wc uqn+ UnScSubst subs -> sayable @saytag $ withContext wc subs++ instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext Coord) where- sayable (WC i c) = sayable @saytag $ contextStr c i+ sayable wc = sayable @saytag $ contextStr wc $ contextData wc instance {-# OVERLAPPABLE #-} $(sayableConstraints ''UnqualifiedName ) => Sayable saytag (WithContext UnqualifiedName) where- sayable (WC n c) =- case n of- SourceName i [] -> sayable @saytag $ WC i c- SourceName i tags -> WC i c &+ ctxLst' tags c ""- OperatorName op [] -> sayable @saytag $ WC op c- OperatorName op tags -> WC op c &+ ctxLst' tags c ""- CtorDtorName cd -> sayable @saytag $ WC cd c- StdSubst subs -> sayable @saytag $ WC subs c- ModuleNamed mn uqn -> ctxLst' mn c "" &+ WC uqn c+ sayable wc =+ case contextData wc of+ SourceName i [] -> sayable @saytag $ withContext wc i+ SourceName i tags -> withContext wc i &+ ctxLst' tags wc ""+ OperatorName op [] -> t'"operator" &+ withContext wc op+ OperatorName op tags -> t'"operator" &+ withContext wc op &+ ctxLst' tags wc ""+ CtorDtorName cd -> sayable @saytag $ withContext wc cd+ StdSubst subs -> sayable @saytag $ withContext wc subs+ ModuleNamed mn uqn -> ctxLst' mn wc "" &+ withContext wc uqn+ -- GCC c++filt style:+ UnnamedTypeName Nothing -> t'"{unnamed type#1" &+ '}'+ UnnamedTypeName (Just nt) -> t'"{unnamed type#" &+ nt + 2 &+ '}'+ -- llvm-cxxfilt style:+ -- UnnamedTypeName Nothing -> t'"'unnamed" &+ '\''+ -- UnnamedTypeName (Just nt) -> t'"'unnamed" &+ nt &+ '\'' + instance {-# OVERLAPPABLE #-} $(sayableConstraints ''SourceName ) => Sayable saytag (WithContext SourceName) where- sayable (WC (SrcName i) c) = sayable @saytag $ contextStr c i+ sayable wc = let SrcName i = contextData wc in sayable @saytag $ contextStr wc i instance {-# OVERLAPPABLE #-} ($(sayableConstraints ''PrefixUQN) , Sayable saytag (WithContext PrefixCDtor) ) => Sayable saytag (WithContext PrefixUQN) where- sayable (WC (PUC p n) c) =+ sayable wc =+ let PUC p n = contextData wc in case n of- CtorDtorName cd -> sayable @saytag $ WC (PCDC p cd) c- _ -> sayable @saytag $ WC n c+ CtorDtorName cd -> sayable @saytag $ withContext wc (PCDC p cd)+ _ -> sayable @saytag $ withContext wc n instance {-# OVERLAPPABLE #-} $(sayableConstraints ''ModuleName ) => Sayable saytag (WithContext ModuleName) where- sayable (WC (ModuleName isP sn) c) =- if isP- then WC sn c &+ ':'- else WC sn c &+ '.'+ sayable wc =+ let ModuleName isP sn = contextData wc+ in if isP then withContext wc sn &+ ':' else withContext wc sn &+ '.' {- | Use Sayable (Prefix, CtorDtor, Context) instead, since CtorDtor needs to reproduce Prefix name. -} instance {-# OVERLAPPABLE #-} $(sayableConstraints ''CtorDtor ) => Sayable saytag (WithContext CtorDtor) where- sayable (WC n c) =- case n of- CompleteCtor -> 'c' &+ '1'- BaseCtor -> 'c' &+ '2'- CompleteAllocatingCtor -> 'c' &+ '3'- CompleteInheritingCtor t -> t'"ci1" &+ WC t c- BaseInheritingCtor t -> t'"ci2" &+ WC t c- DeletingDtor -> 'd' &+ '0'- CompleteDtor -> 'd' &+ '1'- BaseDtor -> 'd' &+ '2'+ sayable wc =+ case contextData wc of+ CompleteCtor -> '(' &+ ')'+ BaseCtor -> '(' &+ ')'+ CompleteAllocatingCtor -> '(' &+ ')'+ CompleteInheritingCtor t -> withContext wc t &+ '(' &+ ')' -- ?+ BaseInheritingCtor t -> withContext wc t &+ '(' &+ ')' -- ?+ DeletingDtor -> '~' &+ '(' &+ ')'+ CompleteDtor -> '~' &+ '(' &+ ')'+ BaseDtor -> '~' &+ '(' &+ ')' instance {-# OVERLAPPABLE #-}- $(sayableConstraints ''PrefixCDtor+ ($(sayableConstraints ''PrefixCDtor) ) => Sayable saytag (WithContext PrefixCDtor) where- sayable (WC (PCDC p n) c) =- let mb'ln = case p of+ sayable wc =+ let PCDC p n = contextData wc+ mb'ln = case p of Prefix pfxr -> pfxrLastUQName pfxr _ -> cannot Demangler "sayable" [ "CTORDTOR UNK PFX: " <> show p ] pfxrLastUQName = \case+ PrefixUQName (UnnamedTypeName _) PrefixEnd -> Nothing+ PrefixUQName (UnnamedTypeName _) (PrefixTemplateArgs _ PrefixEnd) -> Nothing PrefixUQName unm PrefixEnd -> Just unm PrefixUQName unm (PrefixTemplateArgs _ PrefixEnd) -> Just unm- PrefixUQName _ sp -> pfxrLastUQName sp+ PrefixUQName unm sp -> pfxrLastUQName sp <|> Just unm -- [note UTC] PrefixTemplateArgs _ sp -> pfxrLastUQName sp PrefixEnd -> Nothing in case mb'ln of Just ln -> case n of- CompleteCtor -> sayable @saytag $ WC ln c- BaseCtor -> sayable @saytag $ WC ln c- CompleteAllocatingCtor -> sayable @saytag $ WC ln c- CompleteInheritingCtor t -> sayable @saytag $ WC t c -- ??- BaseInheritingCtor t -> sayable @saytag $ WC t c -- ??- DeletingDtor -> '~' &+ WC ln c- CompleteDtor -> '~' &+ WC ln c- BaseDtor -> '~' &+ WC ln c- Nothing -> t'"unk_" &+ WC n c -- unlikely... and will be wrong+ CompleteCtor -> sayable @saytag $ withContext wc ln+ BaseCtor -> sayable @saytag $ withContext wc ln+ CompleteAllocatingCtor -> sayable @saytag $ withContext wc ln+ CompleteInheritingCtor t -> sayable @saytag $ withContext wc t -- ??+ BaseInheritingCtor t -> sayable @saytag $ withContext wc t -- ??+ DeletingDtor -> '~' &+ withContext wc ln+ CompleteDtor -> '~' &+ withContext wc ln+ BaseDtor -> '~' &+ withContext wc ln+ Nothing -> sayable @saytag $ withContext wc n +-- [Note UTC:] When printing a constructor or destructor that includes an+-- UnnamedTypeName, there are differences between GCC's c++filt and LLVM's+-- llvm-cxxfilt. We adopt the former because the demangle tests use c++filt as+-- an oracle, but it is possible to switch to the LLVM style (at compile time) by+-- removing the alternative return of Just unm from the indicated+--+-- Example:+-- _ZN3FooUt3_C2Ev is the base constructor for the 5th unnamed type+-- in the Foo namespace.+--+-- c++filt _ZN3FooUt3_C2Ev -------> Foo::{unnamed type#5}::Foo()+-- llvm-cxxfilt _ZN3FooUt3_C2Ev --> Foo::'unnamed3'::()' + instance {-# OVERLAPPABLE #-} $(sayableConstraints ''Operator ) => Sayable saytag (WithContext Operator) where- sayable (WC op c) =+ sayable wc =+ let op = contextData wc in case lookup op opTable of- Just (_, o) -> t'"operator" &+ o+ Just (_, (_, o)) -> sayable @saytag o Nothing ->+ -- TODO: if these are printed as part of an expression rather than an+ -- UnqualifiedName, the prefix space will be wrong (the latter prints+ -- "operator" to name the function whereas the former just prints the+ -- operation). If this is an issue, probably needs to be a flag in+ -- WithContext to indicate if this is an expression or not. case op of- OpCast ty -> t'"operator" &- WC ty c- OpString snm -> sayable @saytag $ WC snm c- OpVendor n snm -> t'"vendor" &- n &- WC snm c+ OpCast ty -> ' ' &+ withContext wc ty+ OpString snm -> ' ' &+ withContext wc snm+ OpVendor n snm -> t'"vendor" &- n &- withContext wc snm -- ? _ -> cannotSay Demangler "sayable" [ "Operator not in opTable or with a specific override:" , show op@@ -281,47 +335,48 @@ ($(sayableConstraints ''NestedName) , Sayable saytag (WithContext PrefixCDtor) ) => Sayable saytag (WithContext NestedName) where- sayable (WC n c) =- let qualrefs q r = ctxLst' q c " " &? wCtx r c- in case n of+ sayable wc =+ let qualrefs q r = ctxLst' q wc " " &? wCtx r wc+ in case contextData wc of NestedName p (CtorDtorName nm) q r ->- qualrefs q r &+ WC p c &+ t'"::" &+ WC (PCDC p nm) c- NestedName EmptyPrefix nm q r -> qualrefs q r &+ WC nm c- NestedName p nm q r -> qualrefs q r &+ WC p c &+ t'"::" &+ WC nm c- NestedTemplateName tp ta q r -> qualrefs q r &+ WC tp c &+ WC ta c+ qualrefs q r &+ withContext wc p &+ t'"::" &+ withContext wc (PCDC p nm)+ NestedName EmptyPrefix nm q r -> qualrefs q r &+ withContext wc nm+ NestedName p nm q r -> qualrefs q r &+ withContext wc p &+ t'"::" &+ withContext wc nm+ NestedTemplateName tp ta q r -> qualrefs q r &+ withContext wc tp &+ withContext wc ta instance {-# OVERLAPPABLE #-} $(sayableConstraints ''Prefix ) => Sayable saytag (WithContext Prefix) where- sayable (WC p c) =- case p of- PrefixTemplateParam tp prefixr -> WC tp c &+ WC prefixr c- PrefixDeclType dt prefixr -> WC dt c &+ WC prefixr c- PrefixClosure cp -> sayable @saytag $ WC cp c -- ??- Prefix prefixr -> sayable @saytag $ WC prefixr c+ sayable wc =+ case contextData wc of+ PrefixTemplateParam tp prefixr -> withContext wc tp &+ withContext wc prefixr+ PrefixDeclType dt prefixr -> withContext wc dt &+ withContext wc prefixr+ PrefixClosure cp -> sayable @saytag $ withContext wc cp -- ??+ Prefix prefixr -> sayable @saytag $ withContext wc prefixr + instance {-# OVERLAPPABLE #-} $(sayableConstraints ''PrefixR ) => Sayable saytag (WithContext PrefixR) where- sayable (WC p c) =- case p of- PrefixUQName uqn pfr@(PrefixUQName {}) -> WC uqn c &+ t'"::" &+ WC pfr c- PrefixUQName uqn pfr -> WC uqn c &+ WC pfr c- PrefixTemplateArgs ta pfr -> WC ta c &+ WC pfr c+ sayable wc =+ case contextData wc of+ PrefixUQName uqn pfr@(PrefixUQName {}) -> withContext wc uqn &+ t'"::" &+ withContext wc pfr+ PrefixUQName uqn pfr -> withContext wc uqn &+ withContext wc pfr+ PrefixTemplateArgs ta pfr -> withContext wc ta &+ withContext wc pfr PrefixEnd -> sayable @saytag $ t'"" instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext CVQualifier) where- sayable (WC q _c) =- case q of+ sayable wc =+ case contextData wc of Restrict -> sayable @saytag $ t'"restrict" Volatile -> sayable @saytag $ t'"volatile" Const_ -> sayable @saytag $ t'"const" instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext RefQualifier) where- sayable (WC q _c) =- case q of+ sayable wc =+ case contextData wc of Ref -> sayable @saytag '&' RefRef -> sayable @saytag $ t'"&&" @@ -329,18 +384,22 @@ ($(sayableConstraints ''TemplatePrefix) , Sayable saytag (WithContext PrefixUQN) ) => Sayable saytag (WithContext TemplatePrefix) where- sayable (WC p c) =- case p of- GlobalTemplate uqns -> ctxLst' uqns c "::"- NestedTemplate pr uqns -> WC pr c &+ t'"::"- &+ ctxLst' (PUC pr <$> uqns) c "::"- TemplateTemplateParam tp -> sayable @saytag $ WC tp c+ sayable wc =+ case contextData wc of+ GlobalTemplate uqns -> ctxLst' uqns wc "::"+ NestedTemplate pr uqns -> withContext wc pr &+ t'"::"+ &+ ctxLst' (PUC pr <$> uqns) wc "::"+ TemplateTemplateParam tp -> sayable @saytag $ withContext wc tp instance {-# OVERLAPPABLE #-} (Sayable saytag (WithContext TemplateArg) ) => Sayable saytag (WithContext TemplateArgs) where- sayable (WC args c) = '<' &+ ctxLst args c &+ templateArgsEnd args+ sayable wc = let args = contextData wc+ args' = filter (not . emptyArgPack) $ NEL.toList args+ emptyArgPack (TArgPack []) = True+ emptyArgPack _ = False+ in '<' &+ ctxLst args' wc &+ templateArgsEnd args -- C++ requires a space between template argument closures to resolve the parsing -- ambiguity between that and a right shift operation.(e.g. "list<foo<int> >"@@ -362,13 +421,13 @@ _ -> ">" instance {-# OVERLAPPABLE #-}- $(sayableConstraints ''TemplateArg+ ($(sayableConstraints ''TemplateArg) ) => Sayable saytag (WithContext TemplateArg) where- sayable (WC p c) =- case p of- TArgType ty -> sayable @saytag $ WC ty c- TArgSimpleExpr ep -> sayable @saytag $ WC ep c- TArgExpr expr -> sayable @saytag $ WC expr c+ sayable wc =+ case contextData wc of+ TArgType ty -> sayable @saytag $ withContextForTemplateArg wc ty+ TArgSimpleExpr ep -> sayable @saytag $ withContextForTemplateArg wc ep+ TArgExpr expr -> sayable @saytag $ withContextForTemplateArg wc expr TArgPack tas -> -- Expected some ellipses (see -- https://en.cppreference.com/w/cpp/language/parameter-pack), but@@ -379,23 +438,79 @@ -- -- Do not simply defer to the TemplateArgs sayable because that will -- engender another pair of surrounding angle brackets.- ctxLst tas c+ ctxLst tas $ withContextForTemplateArg wc () instance {-# OVERLAPPABLE #-} $(sayableConstraints ''Expression ) => Sayable saytag (WithContext Expression) where- sayable (WC e c) =- case e of- ExprPack expr -> sayable @saytag $ WC expr c- ExprTemplateParam tp -> sayable @saytag $ WC tp c- ExprPrim pe -> sayable @saytag $ WC pe c-+ sayable wc =+ case contextData wc of+ ExprUnary op expr -> withContext wc op &+ withContext wc expr+ ExprBinary op expr1 expr2 -> withContext wc expr1 &+ withContext wc op &+ withContext wc expr2+ ExprTrinary op expr1 expr2 expr3 ->+ '(' &+ withContext wc expr1 &+ ')' &+ withContext wc op &+ withContext wc expr2 &- ':' &- withContext wc expr3+ ExprPfxPlus expr -> t'"++" &+ withContext wc expr+ ExprPfxMinus expr -> t'"--" &+ withContext wc expr+ ExprCall (exprc :| args) -> withContext wc exprc &+ '(' &+ ctxLst args wc &+ ')'+ ExprConvert1 ty expr -> '(' &+ withContext wc ty &+ ')' &+ withContext wc expr+ ExprConvertSome ty exprs -> '(' &+ withContext wc ty &+ t'")(" &+ ctxLst exprs wc &+ ')'+ ExprConvertInit ty brexprs -> withContext wc ty &+ '{' &+ ctxLst brexprs wc &+ '}'+ ExprBracedInit brexprs -> '{' &+ ctxLst brexprs wc &+ '}'+ ExprNew gs exprs ty -> t'"new (" &+ ctxLst exprs wc &+ ')'+ &- (if gs then "::" else t'"") &+ withContext wc ty+ ExprNewInit gs exprs ty i -> t'"new (" &+ ctxLst exprs wc &+ ')'+ &- (if gs then "::" else t'"") &+ withContext wc ty+ &- '(' &+ withContext wc i &+ ')'+ ExprNewArray gs exprs ty -> t'"new[] (" &+ ctxLst exprs wc &+ ')'+ &- (if gs then "::" else t'"") &+ withContext wc ty+ ExprNewInitArray gs exprs ty i -> t'"new[] (" &+ ctxLst exprs wc &+ ')'+ &- (if gs then "::" else t'"") &+ withContext wc ty+ &- '(' &+ withContext wc i &+ ')'+ ExprDel gs expr -> t'"delete" &- (if gs then "::" else t'"") -- ??+ &+ withContext wc expr+ ExprDelArray gs expr -> t'"delete[]" &- (if gs then "::" else t'"") -- ??+ &+ withContext wc expr+ ExprDynamicCast ty expr -> t'"dynamic_cast<" &+ withContext wc ty &+ t'">("+ &+ withContext wc expr &+ ')'+ ExprStaticCast ty expr -> t'"static_cast<" &+ withContext wc ty &+ t'">("+ &+ withContext wc expr &+ ')'+ ExprConstCast ty expr -> t'"const_cast<" &+ withContext wc ty &+ t'">("+ &+ withContext wc expr &+ ')'+ ExprReinterpretCast ty expr -> t'"reinterpret_cast<" &+ withContext wc ty &+ t'">("+ &+ withContext wc expr &+ ')'+ ExprTypeIdType ty -> t'"typeid(" &+ withContext wc ty &+ ')'+ ExprTypeId expr -> t'"typeid(" &+ withContext wc expr &+ ')'+ ExprSizeOfType ty -> t'"sizeof(" &+ withContext wc ty &+ ')'+ ExprSizeOf expr -> t'"sizeof(" &+ withContext wc expr &+ ')'+ ExprAlignOfType ty -> t'"alignof(" &+ withContext wc ty &+ ')'+ ExprAlignOf expr -> t'"alignof(" &+ withContext wc expr &+ ')'+ ExprNoException expr -> t'"noexcept(" &+ withContext wc expr &+ ')'+ ExprTemplateParam tp -> sayable @saytag $ withContext wc tp+ ExprFunctionParam fp -> sayable @saytag $ withContext wc fp+ ExprField expr urn -> withContext wc expr &+ '.' &+ withContext wc urn+ ExprFieldPtr expr urn -> withContext wc expr &+ t'"->" &+ withContext wc urn+ ExprFieldExpr baseExp fieldExp -> withContext wc baseExp &+ t'".*" &+ withContext wc fieldExp+ ExprSizeOfTmplParamPack tp -> t'"sizeof...(" &+ withContext wc tp &+ ')'+ ExprSizeOfFuncParamPack fp -> t'"sizeof...(" &+ withContext wc fp &+ ')'+ ExprSizeOfCapturedTmplParamPack tas -> t'"sizeof...(" &+ ctxLst tas wc &+ ')'+ ExprPack expr -> withContext wc expr &+ t'"..."+ ExprUnaryLeftFold op expr -> '(' &+ t'"..." &- withContext wc op &- withContext wc expr &+ ')'+ ExprUnaryRightFold op expr -> '(' &+ withContext wc expr &- withContext wc op &- t'"..." &+ ')'+ ExprBinaryLeftFold op exprL exprR ->+ '(' &+ withContext wc exprL &- withContext wc op &- t'"..." &- withContext wc op &- withContext wc exprR &+ ')'+ ExprBinaryRightFold op exprL exprR ->+ '(' &+ withContext wc exprL &- withContext wc op &- t'"..." &- withContext wc op &- withContext wc exprR &+ ')'+ ExprThrow expr -> t'"throw" &- withContext wc expr+ ExprReThrow -> sayable @saytag $ t'"throw"+ ExprVendorExtended sn tas -> withContext wc sn &+ '<' &+ ctxLst tas wc &+ '>'+ ExprUnresolvedName urn -> sayable @saytag $ withContext wc urn+ ExprPrim pe -> sayable @saytag $ withContext wc pe instance {-# OVERLAPPABLE #-} $(sayableConstraints ''ExprPrimary ) => Sayable saytag (WithContext ExprPrimary) where- sayable (WC e c) =- case e of+ sayable wc =+ case contextData wc of IntLit ty n -> -- Normally these are printed with a typecast (e.g. `(type)`) ". -- However, C and C++ have some special situations where they can use@@ -404,36 +519,124 @@ case ty of BaseType Bool_ -> t'"" &+ if n > 0 then t'"true" else t'"false" BaseType bty -> case lookup bty builtinTypeTable of- Just (_, cst, sfx) -> if T.null sfx- then '(' &+ cst &+ ')' &+ n- else n &+ sfx- _ -> '(' &+ WC ty c &+ ')' &+ n- _ -> '(' &+ WC ty c &+ ')' &+ n- FloatLit ty n -> '(' &+ WC ty c &+ ')' &+ n- ComplexFloatLit ty r i -> '(' &+ WC ty c &+ ')' &+ '(' &+ r &+ ',' &- i &+ ')'- DirectLit ty -> '(' &+ WC ty c &+ t'")NULL" -- except String?- NullPtrTemplateArg ty -> '(' &+ WC ty c &+ t'")0"- ExternalNameLit enc -> sayable @saytag $ WC enc c+ Just (_, _, Just sfx) -> n &+ sfx+ Just (_, cst, Nothing) -> '(' &+ cst &+ ')' &+ n+ _ -> '(' &+ withContext wc ty &+ ')' &+ n+ _ -> '(' &+ withContext wc ty &+ ')' &+ n+ FloatLit ty n -> '(' &+ withContext wc ty &+ ')' &+ n+ ComplexFloatLit ty r i -> '(' &+ withContext wc ty &+ ')' &+ '(' &+ r &+ ',' &- i &+ ')'+ DirectLit ty -> '(' &+ withContext wc ty &+ t'")NULL" -- except String?+ NullPtrTemplateArg ty -> '(' &+ withContext wc ty &+ t'")0"+ ExternalNameLit enc -> sayable @saytag $ withContext wc enc +instance {-# OVERLAPPABLE #-}+ $(sayableConstraints ''BracedExpression+ ) => Sayable saytag (WithContext BracedExpression) where+ sayable wc =+ case contextData wc of+ BracedExpr e -> sayable @saytag $ withContext wc e+ BracedFieldExpr sn be' -> '.' &+ withContext wc sn &+ withContext wc be'+ BracedIndexExpr ixe be' ->+ '[' &+ withContext wc ixe &+ ']' &+ '=' &+ '(' &+ withContext wc be' &+ ')'+ BracedRangedExpr sr er be' -> '[' &+ withContext wc sr &- t'"..." &- withContext wc er &+ ']'+ &- '=' &- withContext wc be'+++instance {-# OVERLAPPABLE #-}+ $(sayableConstraints ''InitializerExpr+ ) => Sayable saytag (WithContext InitializerExpr) where+ sayable wc = let Initializer ies = contextData wc in ctxLst ies wc+++instance {-# OVERLAPPABLE #-}+ $(sayableConstraints ''FunctionParam+ ) => Sayable saytag (WithContext FunctionParam) where+ sayable wc =+ case contextData wc of+ FP_This -> sayable @saytag $ t'"this"+ FP_ cvq n -> sayable @saytag $ '{' &+ ctxLst' cvq wc " " &+ t'"parm#" &+ n &+ '}'+++instance {-# OVERLAPPABLE #-}+ $(sayableConstraints ''UnresolvedName+ ) => Sayable saytag (WithContext UnresolvedName) where+ sayable wc =+ case contextData wc of+ URN_Base True burn -> t'"::" &+ withContext wc burn+ URN_Base False burn -> sayable @saytag $ withContext wc burn+ URNScopedRef urt burn -> withContext wc urt &+ t'"::" &+ withContext wc burn+ URNSubScopedRef urt urqls burn -> withContext wc urt &+ t'"::"+ &+ ctxLst' urqls wc (t'"::")+ &+ t'"::" &+ withContext wc burn+ URNQualRef True urqls burn -> t'"::"+ &+ ctxLst' urqls wc (t'"::")+ &+ t'"::" &+ withContext wc burn+ URNQualRef False urqls burn -> ctxLst' urqls wc (t'"::")+ &+ t'"::" &+ withContext wc burn+++instance {-# OVERLAPPABLE #-}+ $(sayableConstraints ''BaseUnresolvedName+ ) => Sayable saytag (WithContext BaseUnresolvedName) where+ sayable wc =+ case contextData wc of+ BUName sn Nothing -> sayable @saytag $ withContext wc sn+ BUName sn (Just targs) -> withContext wc sn &+ withContext wc targs+ BUOnOperator op -> sayable @saytag $ withContext wc op+ BUOnOperatorT op targs -> withContext wc op &+ withContext wc targs -- ?+ BUDestructorUnresolvedType urt -> '~' &+ withContext wc urt+ BUDestructorSimpleId sn Nothing -> '~' &+ withContext wc sn+ BUDestructorSimpleId sn (Just targs) -> '~' &+ withContext wc sn &+ withContext wc targs+++instance {-# OVERLAPPABLE #-}+ $(sayableConstraints ''UnresolvedType+ ) => Sayable saytag (WithContext UnresolvedType) where+ sayable wc =+ case contextData wc of+ URTTemplate tp Nothing -> sayable @saytag $ withContext wc tp+ URTTemplate tp (Just targs) -> withContext wc tp &+ withContext wc targs+ URTDeclType dt -> sayable @saytag $ withContext wc dt+ URTSubstPrefix pfx -> sayable @saytag $ withContext wc pfx+++instance {-# OVERLAPPABLE #-}+ $(sayableConstraints ''UnresolvedQualifierLevel+ ) => Sayable saytag (WithContext UnresolvedQualifierLevel) where+ sayable wc =+ case contextData wc of+ URQL sn Nothing -> sayable @saytag $ withContext wc sn+ URQL sn (Just targs) -> withContext wc sn &+ withContext wc targs+++instance {-# OVERLAPPABLE #-}+ $(sayableConstraints ''DeclType+ ) => Sayable saytag (WithContext DeclType) where+ sayable wc =+ case contextData wc of+ DeclType expr -> t'"decltype (" &+ withContext wc expr &+ ')'+ DeclTypeExpr expr -> t'"decltype (" &+ withContext wc expr &+ ')'++ instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext ClosurePrefix) where- sayable (WC _p _c) = cannotSay Demangler "sayable"- [ "No Sayable for ClosurePrefix" ]+ sayable _ = cannotSay Demangler "sayable"+ [ "No Sayable for ClosurePrefix" ] instance {-# OVERLAPPABLE #-} $(sayableConstraints ''Substitution ) => Sayable saytag (WithContext Substitution) where- sayable (WC p c) =- case p of+ sayable wc =+ case contextData wc of SubStd -> t'"std" &+ t'"" SubAlloc -> t'"std" &+ t'"::allocator" SubBasicString -> t'"std" &+ t'"::basic_string"- SubStdType stdTy -> sayable @saytag $ WC stdTy c+ SubStdType stdTy -> sayable @saytag $ withContext wc stdTy instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext StdType) where- sayable (WC stdTy _c) =+ sayable wc = let ct = t'"std::char_traits<char>" in- case stdTy of+ case contextData wc of BasicStringChar -> t'"std::basic_string<char," &- ct &+ t'", std::allocator<char> >" BasicIStream -> t'"std::basic_istream<char," &- ct &- '>' BasicOStream -> t'"std::basic_ostream<char," &- ct &- '>'@@ -445,55 +648,63 @@ instance {-# OVERLAPPABLE #-} $(sayableConstraints ''ABI_Tag ) => Sayable saytag (WithContext ABI_Tag) where- sayable (WC (ABITag p) c) = t'"[abi:" &+ WC p c &+ ']'+ sayable wc = let ABITag p = contextData wc in t'"[abi:" &+ withContext wc p &+ ']' instance {-# OVERLAPPABLE #-} $(sayableConstraints ''Type_ ) => Sayable saytag (WithContext Type_) where- sayable (WC ty c) =- case ty of- BaseType t -> sayable @saytag $ WC t c- QualifiedType [] [] t -> sayable @saytag $ WC t c- QualifiedType eqs [] t -> WC t c &+ ctxLst' eqs c " "- QualifiedType [] cvqs t -> WC t c &- ctxLst' cvqs c " "- QualifiedType eqs cvqs t -> WC t c &- ctxLst' eqs c " " &- ctxLst' cvqs c " "- ClassUnionStructEnum n -> sayable @saytag $ WC n c- ClassStruct n -> sayable @saytag $ WC n c- Union n -> sayable @saytag $ WC n c- Enum n -> sayable @saytag $ WC n c- Function {} -> sayFunctionType ty "" c- Pointer f@(Function {}) -> sayFunctionType f "(*)" c- Pointer (ArrayType bnd t) -> WC t c &- t'"(*)" &- '[' &+ WC bnd c &+ ']'- Pointer t -> WC t c &+ '*'- LValRef (ArrayType bnd t) -> WC t c &- t'"(&)" &- '[' &+ WC bnd c &+ ']'- LValRef t -> WC t c &+ '&'- RValRef t -> WC t c &+ t'"&&"- ComplexPair t -> WC t c &- t'"complex"- Imaginary t -> WC t c &- t'"imaginary"- ArrayType bnd t -> WC t c &+ '[' &+ WC bnd c &+ ']'- Template tp ta -> WC tp c &- WC ta c -- ??+ sayable wc =+ case contextData wc of+ BaseType t -> sayable @saytag $ withContext wc t+ QualifiedType [] [] t -> sayable @saytag $ withContext wc t+ QualifiedType eqs [] t -> withContext wc t &+ ctxLst' eqs wc " "+ QualifiedType [] cvqs t -> withContext wc t &- ctxLst' cvqs wc " "+ QualifiedType eqs cvqs t -> withContext wc t &- ctxLst' eqs wc " " &- ctxLst' cvqs wc " "+ ClassUnionStructEnum n -> sayable @saytag $ withContext wc n+ ClassStruct n -> sayable @saytag $ withContext wc n+ Union n -> sayable @saytag $ withContext wc n+ Enum n -> sayable @saytag $ withContext wc n+ ty@(Function {}) -> sayFunctionType ty (t'"") wc+ Pointer f@(Function {}) -> sayFunctionType f (t'"(*)") wc+ Pointer (ArrayType bnd t) -> withContext wc t &- t'"(*)" &- '[' &+ withContext wc bnd &+ ']'+ Pointer t -> withContext wc t &+ '*'+ LValRef (ArrayType bnd t) -> withContext wc t &- t'"(&)" &- '[' &+ withContext wc bnd &+ ']'+ LValRef t -> withContext wc t &+ '&'+ RValRef (LValRef t@(QualifiedType _ [Const_] _)) ->+ -- An rvalue may be used to initialize a const lvalue reference; see+ -- https://en.cppreference.com/w/cpp/language/value_category+ sayable @saytag $ withContext wc (LValRef t)+ RValRef t -> withContext wc t &+ t'"&&"+ ComplexPair t -> withContext wc t &- t'"complex"+ Imaginary t -> withContext wc t &- t'"imaginary"+ ArrayType bnd t -> withContext wc t &+ '[' &+ withContext wc bnd &+ ']'+ Template tp ta -> withContext wc tp &- withContext wc ta -- ?? Cpp11PackExpansion ts -> -- XXX expected some "..." (see -- https://en.cppreference.com/w/cpp/language/parameter-pack) but c++filt -- does not visibly decorate these.- ctxLst ts c- StdType stdTy -> sayable @saytag $ WC stdTy c+ ctxLst ts wc+ StdType stdTy -> sayable @saytag $ withContext wc stdTy+ DeclType_ dt -> sayable @saytag $ withContext wc dt+ PointerToMember cty mty@(Function {}) ->+ sayFunctionType mty ('(' &+ withContext wc cty &+ t'"::*)") wc+ PointerToMember cty mty -> '(' &+ withContext wc cty &+ t'"::*)" &+ withContext wc mty -- ?? -sayFunctionType :: Type_ -> Text -> Context -> Saying saytag-sayFunctionType (Function cvqs mb'exc trns isExternC rTy argTys mb'ref) nm c =- ctxLst' cvqs c " "- &? wCtx mb'exc c- &+ WC trns c+sayFunctionType :: Sayable saytag nm => Type_ -> nm -> WithContext Type_ -> Saying saytag+sayFunctionType (Function cvqs mb'exc trns isExternC rTy argTys mb'ref) nm wc =+ ctxLst' cvqs wc " "+ &? wCtx mb'exc wc+ &+ withContext wc trns &+ (if isExternC then t'" extern \"C\"" else t'"")- &+ WC rTy c+ &+ withContext wc rTy &- nm &+ '(' &+* (case argTys of BaseType Void :| [] -> []- _ -> wCtx (NEL.toList argTys) c+ _ -> wCtx (NEL.toList argTys) wc ) &+ ')'- &? wCtx mb'ref c+ &? wCtx mb'ref wc sayFunctionType _ _ _ = cannotSay Demangler "sayFunctionType" [ "Called with a type that is not a Function!" ] @@ -501,48 +712,48 @@ instance {-# OVERLAPPABLE #-} $(sayableConstraints ''ArrayBound ) => Sayable saytag (WithContext ArrayBound) where- sayable (WC n c) =- case n of+ sayable wc =+ case contextData wc of NoBounds -> sayable @saytag $ t'"" NumBound i -> sayable @saytag i- ExprBound e -> sayable @saytag $ WC e c+ ExprBound e -> sayable @saytag $ withContext wc e instance {-# OVERLAPPABLE #-} $(sayableConstraints ''ExceptionSpec ) => Sayable saytag (WithContext ExceptionSpec) where- sayable (WC exc c) =- case exc of+ sayable wc =+ case contextData wc of NonThrowing -> sayable @saytag $ t'"noexcept"- ComputedThrow expr -> t'"throw" &- WC expr c -- ?- Throwing tys -> t'"throw (" &+ wCtx tys c &+ ')' -- ?+ ComputedThrow expr -> t'"throw" &- withContext wc expr -- ?+ Throwing tys -> t'"throw (" &+ wCtx tys wc &+ ')' -- ? instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext Transaction) where- sayable (WC trns _c) =- case trns of+ sayable wc =+ case contextData wc of TransactionSafe -> sayable @saytag $ t'"safe" -- ? TransactionUnsafe -> sayable @saytag $ t'"" instance {-# OVERLAPPABLE #-} $(sayableConstraints ''BaseType ) => Sayable saytag (WithContext BaseType) where- sayable (WC t c) =- case lookup t builtinTypeTable of+ sayable wc =+ case lookup (contextData wc) builtinTypeTable of Just (_,s,_) -> sayable @saytag s Nothing ->- case t of+ case contextData wc of FloatN n -> t'"std::float" &+ n &+ t'"_t" FloatNx n -> t'"std::float" &+ n &+ t'"x_t" SBitInt n -> t'"signed _BitInt(" &+ n &+ ')' UBitInt n -> t'"unsigned _BitInt(" &+ n &+ ')'- VendorExtendedType nm mb'ta -> WC nm c &? wCtx mb'ta c- _ -> cannotSay Demangler "sayable.Basetype"+ VendorExtendedType nm mb'ta -> withContext wc nm &? wCtx mb'ta wc+ t -> cannotSay Demangler "sayable.Basetype" [ "Unknown BaseType not listed in the builtinTypeTable" , show t ] instance {-# OVERLAPPABLE #-} Sayable saytag (WithContext CallOffset) where- sayable (WC _co _c) =+ sayable _wc = cannotSay Demangler "Sayable CallOffset" [ "The CallOffset is for a thunk or covariant return thunk" , "and is not expected to be printed."@@ -551,10 +762,11 @@ instance {-# OVERLAPPABLE #-} $(sayableConstraints ''SubsCandidate ) => Sayable saytag (WithContext SubsCandidate) where- sayable (WC cand c) = -- For debug only- case cand of- SC_Type t -> t'"SC_Ty" &- WC t c- SC_UQName True n -> t'"SC_UN" &- t'"std::" &+ WC n c- SC_UQName _ n -> t'"SC_UN" &- WC n c- SC_Prefix p -> t'"SC_PR" &- WC p c- SC_TemplatePrefix tp -> t'"SC_TP" &- WC tp c+ sayable wc = -- For debug only+ case contextData wc of+ SC_Type t -> t'"SC_Ty" &- withContext wc t+ SC_UQName True n -> t'"SC_UN" &- t'"std::" &+ withContext wc n+ SC_UQName _ n -> t'"SC_UN" &- withContext wc n+ SC_Prefix p -> t'"SC_PR" &- withContext wc p+ SC_TemplatePrefix tp -> t'"SC_TP" &- withContext wc tp+ SC_UnresolvedType urt -> t'"SC_URT" &- withContext wc urt
src/Demangler/Structure.hs view
@@ -10,6 +10,15 @@ import Demangler.Context +-- | The Demangled data structure holds the demangled name in data-oriented+-- format. This format encodes the various roles and portions of the mangled+-- name in an AST-like structure that closely matches the mangled specification.+-- Unfortunately, this is a relatively messy representation that is not easy to+-- work with, and where things that might seem simple (e.g. the base function+-- name) can be encoded in a number of different ways. Therefore, the details of+-- this structure are not exported and it should either be rendered to printable+-- version via the 'sayable' package or inspected via accessor functions (like+-- 'functionName'). data Demangled = Original Coord | Encoded Encoding@@ -39,12 +48,16 @@ deriving (Eq, Show) data Name = NameNested NestedName- | UnscopedName Bool UnqualifiedName -- Bool is "std::" prefix+ | UnscopedName UnscopedName | UnscopedTemplateName Name TemplateArgs | LocalName Encoding Name (Maybe Discriminator) | StringLitName Encoding (Maybe Discriminator) deriving (Eq, Show) +data UnscopedName = UnScName Bool UnqualifiedName -- Bool is "std::" prefix+ | UnScSubst Substitution+ deriving (Eq, Show)+ data NestedName = NestedName Prefix UnqualifiedName [CVQualifier] (Maybe RefQualifier) | NestedTemplateName TemplatePrefix TemplateArgs@@ -52,8 +65,17 @@ deriving (Eq, Show) type FunctionEntity = Coord-type Discriminator = Coord +-- The Discriminator is simply a non-negative number used to identify a+-- particular instance of a name. It is the rather unusual case for C++ that+-- there may be several distinct functions that have the exact same demangled+-- representation. This can also happen if multiple entities with the same name+-- in different scopes. The Discriminator is used to identify which actual+-- function is being referenced, even though it's not possible to tell which one+-- based on the visible demangled name.+newtype Discriminator = Discriminator Natural+ deriving (Eq, Show)+ data ModuleName = ModuleName IsPartition SourceName deriving (Eq, Show) @@ -64,7 +86,7 @@ | CtorDtorName CtorDtor | StdSubst Substitution | ModuleNamed [ModuleName] UnqualifiedName- -- | UnnamedTypeName ... starts with "U"+ | UnnamedTypeName (Maybe Natural) -- Nothing = first instance -- | StructuredBinding ... deriving (Eq, Show) @@ -185,6 +207,8 @@ | Cpp11PackExpansion (NonEmpty Type_) | StdType StdType | ArrayType ArrayBound Type_+ | DeclType_ DeclType+ | PointerToMember Type_ Type_ -- class type, member type deriving (Eq, Show) data ArrayBound = NumBound Int@@ -275,11 +299,55 @@ type TemplateParam = TemplateArg -data Expression = ExprPack Expression+data Expression = ExprUnary Operator Expression+ | ExprBinary Operator Expression Expression+ | ExprTrinary Operator Expression Expression Expression+ | ExprPfxPlus Expression+ | ExprPfxMinus Expression+ | ExprCall (NonEmpty Expression) -- call target :| [args]+ | ExprConvert1 Type_ Expression+ | ExprConvertSome Type_ (NonEmpty Expression)+ | ExprConvertInit Type_ [BracedExpression]+ | ExprBracedInit [BracedExpression]+ | ExprNew GlobalScope [Expression] Type_+ | ExprNewInit GlobalScope [Expression] Type_ InitializerExpr+ | ExprNewArray GlobalScope [Expression] Type_+ | ExprNewInitArray GlobalScope [Expression] Type_ InitializerExpr+ | ExprDel GlobalScope Expression+ | ExprDelArray GlobalScope Expression+ | ExprDynamicCast Type_ Expression+ | ExprStaticCast Type_ Expression+ | ExprConstCast Type_ Expression+ | ExprReinterpretCast Type_ Expression+ | ExprTypeIdType Type_+ | ExprTypeId Expression+ | ExprSizeOfType Type_+ | ExprSizeOf Expression+ | ExprAlignOfType Type_+ | ExprAlignOf Expression+ | ExprNoException Expression | ExprTemplateParam TemplateParam+ | ExprFunctionParam FunctionParam+ | ExprField Expression UnresolvedName+ | ExprFieldPtr Expression UnresolvedName+ | ExprFieldExpr Expression Expression+ | ExprSizeOfTmplParamPack TemplateParam+ | ExprSizeOfFuncParamPack FunctionParam+ | ExprSizeOfCapturedTmplParamPack [TemplateArg]+ | ExprPack Expression+ | ExprUnaryLeftFold Operator Expression+ | ExprUnaryRightFold Operator Expression+ | ExprBinaryLeftFold Operator Expression Expression+ | ExprBinaryRightFold Operator Expression Expression+ | ExprThrow Expression+ | ExprReThrow+ | ExprVendorExtended SourceName [TemplateArg]+ | ExprUnresolvedName UnresolvedName | ExprPrim ExprPrimary deriving (Eq, Show) +type GlobalScope = Bool+ data ExprPrimary = IntLit Type_ Int | FloatLit Type_ Float | DirectLit Type_ -- String or NullPtr@@ -288,111 +356,160 @@ | ExternalNameLit Encoding deriving (Eq, Show) +data BracedExpression = BracedExpr Expression+ | BracedFieldExpr SourceName BracedExpression -- .name = expr+ | BracedIndexExpr Expression BracedExpression -- [idx] = expr+ | BracedRangedExpr Expression Expression BracedExpression+ -- [expr ... expr] = expr+ deriving (Eq, Show)++data InitializerExpr = Initializer [Expression]+ deriving (Eq, Show)++data FunctionParam = FP_This+ | FP_ [CVQualifier] Natural+ deriving (Eq, Show)++data UnresolvedName = URN_Base GlobalScope BaseUnresolvedName+ | URNScopedRef UnresolvedType BaseUnresolvedName+ | URNSubScopedRef UnresolvedType+ UnresolvedQualifierLevels BaseUnresolvedName+ | URNQualRef GlobalScope+ UnresolvedQualifierLevels BaseUnresolvedName+ deriving (Eq, Show)++type UnresolvedQualifierLevels = NonEmpty UnresolvedQualifierLevel++data BaseUnresolvedName = BUName SourceName (Maybe TemplateArgs)+ | BUOnOperatorT Operator TemplateArgs+ | BUOnOperator Operator+ | BUDestructorUnresolvedType UnresolvedType+ | BUDestructorSimpleId SourceName (Maybe TemplateArgs)+ deriving (Eq, Show)+++data UnresolvedType = URTTemplate TemplateParam (Maybe TemplateArgs)+ | URTDeclType DeclType+ | URTSubstPrefix Prefix -- never parsed: subst insertion+ deriving (Eq, Show)+++data UnresolvedQualifierLevel = URQL SourceName (Maybe TemplateArgs)+ deriving (Eq, Show)+ type ClosurePrefix = () -- XXX TBD-type DeclType = () -- XXX TBD ++data DeclType = DeclType Expression+ | DeclTypeExpr Expression+ deriving (Eq, Show)++ -- | Table of builtin types as the internal BaseType representation, followed by -- a tuple of strings. The first string is the reference to this type in a -- mangled name. The second string is the C/C++ type name to be used when--- writing a value cast. The third string, if non-empty, is a C/C++ suffix that+-- writing a value cast. The third string, if specified, is a C/C++ suffix that -- can be written after literal values to indicate the type instead (for example, -- emit `10ul` instead of `(unsigned long)10`). -builtinTypeTable :: [ (BaseType, (Text, Text, Text)) ]+builtinTypeTable :: [ (BaseType, (Text, Text, Maybe Text)) ] builtinTypeTable =- [ (Void, ("v", "void", ""))- , (Wchar_t, ("w", "wchar_t", ""))- , (Bool_, ("b", "bool", ""))- , (Char_, ("c", "char", ""))- , (SChar, ("a", "signed char", ""))- , (UChar, ("h", "unsigned char", ""))- , (Short, ("s", "short", ""))- , (UShort, ("t", "unsigned short", ""))- , (Int_, ("i", "int", ""))- , (UInt, ("j", "unsigned int", ""))- , (Long, ("l", "long", "l"))- , (ULong, ("m", "unsigned long", "ul"))- , (LongLong, ("x", "long long", "")) -- __int64- , (ULongLong, ("y", "unsigned long long", "")) -- __int64- , (Int128, ("n", "__int128", ""))- , (UInt128, ("o", "unsigned __int128", ""))- , (Float_, ("f", "float", ""))- , (Double_, ("d", "double", ""))- , (LongDouble80, ("e", "long double", "")) -- __float80- , (Float128, ("g", "__float128", ""))- , (Ellipsis, ("z", "...", ""))- , (IEE754rDecFloat64, ("Dd", "__ieeefloat64", "")) -- ??- , (IEE754rDecFloat128, ("De", "__ieeefloat128", "")) -- ??- , (IEE754rDecFloat32, ("Df", "__ieeefloat32", "")) -- ??- , (IEE754rDecFloat16, ("Dh", "__ieeefloat16", "")) -- ??- , (BFloat16, ("DF16b", "std::bfloat16_t", ""))- , (Char32, ("Di", "char32_t", ""))- , (Char16, ("Ds", "char16_t", ""))- , (Char8, ("Du", "char8_t", ""))- , (Auto, ("Da", "auto", ""))- , (DeclTypeAuto, ("Dc", "decltype(auto)", "")) -- ??- , (NullPtr, ("Dn", "std::nullptr_t", "")) -- decltype(nullptr)- , (N1168FixedPointAccum, ("DA", "T _Accum", "")) -- ??- , (N1168FixedPointAccumSat, ("DS DA", "_Sat T _Accum", "")) -- ??- , (N1168FixedPointFract, ("DR", "T _Fract", "")) -- ??- , (N1168FixedPointFractSat, ("DS DR", "_Sat T _Fract", "")) -- ??+ [ (Void, ("v", "void", Nothing))+ , (Wchar_t, ("w", "wchar_t", Nothing))+ , (Bool_, ("b", "bool", Nothing))+ , (Char_, ("c", "char", Nothing))+ , (SChar, ("a", "signed char", Nothing))+ , (UChar, ("h", "unsigned char", Nothing))+ , (Short, ("s", "short", Nothing))+ , (UShort, ("t", "unsigned short", Nothing))+ , (Int_, ("i", "int", Just ""))+ , (UInt, ("j", "unsigned int", Just "u"))+ , (Long, ("l", "long", Just "l"))+ , (ULong, ("m", "unsigned long", Just "ul"))+ , (LongLong, ("x", "long long", Nothing)) -- __int64+ , (ULongLong, ("y", "unsigned long long", Nothing)) -- __int64+ , (Int128, ("n", "__int128", Nothing))+ , (UInt128, ("o", "unsigned __int128", Nothing))+ , (Float_, ("f", "float", Nothing))+ , (Double_, ("d", "double", Nothing))+ , (LongDouble80, ("e", "long double", Nothing)) -- __float80+ , (Float128, ("g", "__float128", Nothing))+ , (Ellipsis, ("z", "...", Nothing))+ , (IEE754rDecFloat64, ("Dd", "__ieeefloat64", Nothing)) -- ??+ , (IEE754rDecFloat128, ("De", "__ieeefloat128", Nothing)) -- ??+ , (IEE754rDecFloat32, ("Df", "__ieeefloat32", Nothing)) -- ??+ , (IEE754rDecFloat16, ("Dh", "__ieeefloat16", Nothing)) -- ??+ , (BFloat16, ("DF16b", "std::bfloat16_t", Nothing))+ , (Char32, ("Di", "char32_t", Nothing))+ , (Char16, ("Ds", "char16_t", Nothing))+ , (Char8, ("Du", "char8_t", Nothing))+ , (Auto, ("Da", "auto", Nothing))+ , (DeclTypeAuto, ("Dc", "decltype(auto)", Nothing)) -- ??+ , (NullPtr, ("Dn", "std::nullptr_t", Nothing)) -- decltype(nullptr)+ , (N1168FixedPointAccum, ("DA", "T _Accum", Nothing)) -- ??+ , (N1168FixedPointAccumSat, ("DS DA", "_Sat T _Accum", Nothing)) -- ??+ , (N1168FixedPointFract, ("DR", "T _Fract", Nothing)) -- ??+ , (N1168FixedPointFractSat, ("DS DR", "_Sat T _Fract", Nothing)) -- ?? ] -opTable :: [ (Operator, (Text, Text)) ]+data Arity = Unary | Binary | Trinary | NoArity+ deriving Eq++opTable :: [ (Operator, (Arity, (Text, Text))) ] opTable =- [ (OpNew, ("nw", " new"))- , (OpNewArr, ("na", " new[]"))- , (OpDel, ("dl", " delete"))- , (OpDelArr, ("da", " delete[]"))- , (OpCoAwait, ("aw", " co_await"))- , (OpPositive, ("ps", "+"))- , (OpNegative, ("ng", "-"))- , (OpAddress, ("ad", "&"))- , (OpDeReference, ("de", "*"))- , (OpComplement, ("co", "~"))- , (OpPlus, ("pl", "+"))- , (OpMinus, ("mi", "-"))- , (OpMultiply, ("ml", "*"))- , (OpDivide, ("dv", "/"))- , (OpRemainder, ("rm", "%"))- , (OpAnd, ("an", "&"))- , (OpOr, ("or", "|"))- , (OpXOR, ("eo", "^"))- , (OpAssign, ("aS", "="))- , (OpAssignPlus, ("pL", "+="))- , (OpAssignMinus, ("mI", "-="))- , (OpAssignMul, ("mL", "*="))- , (OpAssignDiv, ("dV", "/="))- , (OpAssignRem, ("rM", "%="))- , (OpAssignAnd, ("aN", "&="))- , (OpAssignOr, ("oR", "|="))- , (OpAssignXOR, ("eO", "^="))- , (OpLeftShift, ("ls", "<<"))- , (OpRightShift, ("rs", ">>"))- , (OpAssignShL, ("lS", "<<="))- , (OpAssignShR, ("rS", ">>="))- , (OpEq, ("eq", "=="))- , (OpNotEq, ("ne", "!="))- , (OpLT, ("lt", "<"))- , (OpGT, ("gt", ">"))- , (OpLTE, ("le", "<="))- , (OpGTE, ("ge", ">="))- , (OpSpan, ("ss", "<=>"))- , (OpNot, ("nt", "!"))- , (OpLogicalAnd, ("aa", "&&"))- , (OpLogicalOr, ("oo", "||"))- , (OpPlusPlus, ("pp", "++"))- , (OpMinusMinus, ("mm", "--"))- , (OpComma, ("cm", ","))- , (OpPointStar, ("pm", "->*"))- , (OpPoint, ("pt", "->"))- , (OpCall, ("cl", "()"))- , (OpIndex, ("ix", "[]"))- , (OpQuestion, ("qu", "?"))- , (OpSizeOfType, ("st", " sizeof"))- , (OpAlignOfType, ("at", " alignof"))- , (OpSizeOfExpr, ("sz", " sizeof"))- , (OpAlignOfExpr, ("az", " alignof"))+ [ (OpNew, (NoArity, ("nw", " new")))+ , (OpNewArr, (NoArity, ("na", " new[]")))+ , (OpDel, (NoArity, ("dl", " delete")))+ , (OpDelArr, (NoArity, ("da", " delete[]")))+ , (OpCoAwait, (NoArity, ("aw", " co_await")))+ , (OpPositive, (Unary, ("ps", "+")))+ , (OpNegative, (Unary, ("ng", "-")))+ , (OpAddress, (Unary, ("ad", "&")))+ , (OpDeReference, (Unary, ("de", "*")))+ , (OpComplement, (Unary, ("co", "~")))+ , (OpPlus, (Binary, ("pl", "+")))+ , (OpMinus, (Binary, ("mi", "-")))+ , (OpMultiply, (Binary, ("ml", "*")))+ , (OpDivide, (Binary, ("dv", "/")))+ , (OpRemainder, (Binary, ("rm", "%")))+ , (OpAnd, (Binary, ("an", "&")))+ , (OpOr, (Binary, ("or", "|")))+ , (OpXOR, (Binary, ("eo", "^")))+ , (OpAssign, (Binary, ("aS", "=")))+ , (OpAssignPlus, (Binary, ("pL", "+=")))+ , (OpAssignMinus, (Binary, ("mI", "-=")))+ , (OpAssignMul, (Binary, ("mL", "*=")))+ , (OpAssignDiv, (Binary, ("dV", "/=")))+ , (OpAssignRem, (Binary, ("rM", "%=")))+ , (OpAssignAnd, (Binary, ("aN", "&=")))+ , (OpAssignOr, (Binary, ("oR", "|=")))+ , (OpAssignXOR, (Binary, ("eO", "^=")))+ , (OpLeftShift, (Binary, ("ls", "<<")))+ , (OpRightShift, (Binary, ("rs", ">>")))+ , (OpAssignShL, (Binary, ("lS", "<<=")))+ , (OpAssignShR, (Binary, ("rS", ">>=")))+ , (OpEq, (Binary, ("eq", "==")))+ , (OpNotEq, (Binary, ("ne", "!=")))+ , (OpLT, (Binary, ("lt", "<")))+ , (OpGT, (Binary, ("gt", ">")))+ , (OpLTE, (Binary, ("le", "<=")))+ , (OpGTE, (Binary, ("ge", ">=")))+ , (OpSpan, (Binary, ("ss", "<=>")))+ , (OpNot, (Unary, ("nt", "!")))+ , (OpLogicalAnd, (Binary, ("aa", "&&")))+ , (OpLogicalOr, (Binary, ("oo", "||")))+ , (OpPlusPlus, (Unary, ("pp", "++")))+ , (OpMinusMinus, (Unary, ("mm", "--")))+ , (OpComma, (Binary, ("cm", ",")))+ , (OpPointStar, (Binary, ("pm", "->*")))+ , (OpPoint, (Binary, ("pt", "->")))+ , (OpCall, (NoArity, ("cl", "()")))+ , (OpIndex, (NoArity, ("ix", "[]")))+ , (OpQuestion, (Trinary, ("qu", "?")))+ , (OpSizeOfType, (Unary, ("st", " sizeof")))+ , (OpAlignOfType, (Unary, ("at", " alignof")))+ , (OpSizeOfExpr, (Unary, ("sz", " sizeof")))+ , (OpAlignOfExpr, (Unary, ("az", " alignof"))) ] @@ -405,4 +522,5 @@ -- ^ Bool is True for std:: namespace prefix | SC_Prefix Prefix | SC_TemplatePrefix TemplatePrefix+ | SC_UnresolvedType UnresolvedType deriving (Eq, Show)
src/Demangler/Substitution.hs view
@@ -10,13 +10,14 @@ -- * Parse a substitution reference substitution -- * Substitute the found substitution into the result- , substituteUnqualifiedName+ , substituteUnscopedName , substitutePrefix , substitutePrefixR , substituteTemplateParam , substituteTemplatePrefix , substituteType , stdSubstToType+ , substituteUnresolvedType -- * When a subtitution candidate has been parsed, it is recorded here , canSubstUnscopedTemplateName , canSubstPrefix@@ -25,6 +26,7 @@ , canSubstTemplatePrefix , canSubstType , canSubstTypes+ , canSubstUnresolvedType , dropLastSubst ) where@@ -38,13 +40,13 @@ import Data.Sequence ( (|>), ViewR((:>)) ) import qualified Data.Sequence as Seq -import Demangler.Context import Demangler.Engine import Demangler.Structure import Demangler.PPrint () #ifdef MIN_VERSION_panic -- The debug flag is enabled in the cabal file+import Demangler.Context import Text.Sayable import Debug.Trace #endif@@ -126,11 +128,11 @@ dumpSubs spec what = do mapM_ (traceM . show) $ Seq.zip (Seq.fromList [0.. Seq.length (spec ^. nSubs)])- ((\ue -> (ue, sez @"debug" (WC ue (spec ^. nContext))))+ ((\ue -> (ue, sez @"debug" (addContext ue (spec ^. nContext)))) <$> spec ^. nSubs) mapM_ (traceM . show) $ Seq.zip (Seq.fromList [0.. Seq.length (spec ^. nTmplSubs)])- ((\ue -> ('T', ue, sez @"debug" (WC ue (spec ^. nContext))))+ ((\ue -> ('T', ue, sez @"debug" (addContext ue (spec ^. nContext)))) <$> spec ^. nTmplSubs) traceM $ "Subs Total: " <> show ((Seq.length $ spec ^. nSubs) + (Seq.length $ spec ^. nTmplSubs)) <> " " <> show ((Seq.length $ spec ^. nSubs), (Seq.length $ spec ^. nTmplSubs))@@ -159,11 +161,29 @@ , show (spec ^. nVal) ] -substituteUnqualifiedName :: Next Substitution UnqualifiedName- -> Next Substitution' UnqualifiedName-substituteUnqualifiedName direct i =+substituteUnscopedName :: Next Substitution UnscopedName+ -> Next Substitution' UnscopedName+substituteUnscopedName direct i = case getSubst i of- Right (Just (SC_UQName _ n)) -> ret i n+ Right (Just (SC_UQName s n)) -> ret i $ UnScName s n+ Right (Just (SC_Prefix p)) ->+ let getUsn = \case+ Prefix prefixr -> getUsn_PR prefixr+ _ -> Nothing+ getUsn_PR = \case+ PrefixUQName uqn PrefixEnd -> Just $ UnScName False uqn+ PrefixUQName (StdSubst SubStd) sp ->+ case getUsn_PR sp of+ Nothing -> Nothing+ Just (UnScName _ uqn) -> Just $ UnScName True uqn+ Just n@(UnScSubst _) -> Just n+ PrefixUQName (StdSubst _) _ -> Nothing+ PrefixUQName _ _ -> Nothing+ PrefixEnd -> Nothing+ PrefixTemplateArgs _ _ -> Nothing+ in case getUsn p of+ Nothing -> Nothing+ Just usn -> ret i usn Right _ -> Nothing Left s -> direct =<< ret i s @@ -173,7 +193,7 @@ Right (Just (SC_Type t)) -> ret i t Right (Just (SC_Prefix p)) -> ret i =<< prefixToType p Right (Just (SC_UQName isStd uqn)) ->- ret i $ ClassUnionStructEnum $ UnscopedName isStd uqn+ ret i $ ClassUnionStructEnum $ UnscopedName $ UnScName isStd uqn Right o -> invalidSubst "Type" i o Left s -> embed =<< ret i s @@ -198,23 +218,51 @@ mkntn tpfx = NestedTemplateName tpfx ta [] Nothing in NameNested . mkntn <$> tmpltpfx +substituteUnresolvedType :: Next Substitution UnresolvedType+ -> Next Substitution' UnresolvedType+substituteUnresolvedType direct i =+ case getSubst i of+ Right (Just (SC_Prefix p)) -> ret i $ URTSubstPrefix p+ Right (Just (SC_UnresolvedType urt)) -> ret i urt+ Right x -> cannot Demangler "substituteUnresolvedType"+ [ "Cannot convert to an unresolved type: " <> show x ]+ Left s -> direct =<< ret i s -substitutePrefix :: (Next Substitution Prefix) -> Next Substitution' Prefix+substitutePrefix :: Next Substitution Prefix -> Next Substitution' Prefix substitutePrefix direct i = case getSubst i of Right (Just (SC_Prefix p)) -> ret i p Right o -> invalidSubst "Prefix" i o Left s -> direct =<< ret i s -substitutePrefixR :: (Next Substitution PrefixR) -> Next Substitution' PrefixR+substitutePrefixR :: Next Substitution PrefixR -> Next Substitution' PrefixR substitutePrefixR direct i = case getSubst i of- Right (Just (SC_Type (ClassUnionStructEnum (UnscopedName False uqn)))) ->- ret i $ PrefixUQName uqn PrefixEnd+ Right o@(Just (SC_Type (ClassUnionStructEnum nm))) ->+ case name2prefix nm of+ Just pfx -> ret i pfx+ Nothing -> invalidSubst "PrefixR.SC_Type.ClassUnionStructEnum" i o Right (Just (SC_Prefix (Prefix sp))) -> ret i sp Right o -> invalidSubst "PrefixR" i o Left s -> ret i s >>= direct+ where+ name2prefix = \case+ NameNested nn -> nn2prefix nn+ UnscopedName (UnScName True _uqn) -> Nothing+ -- Just $ PrefixUQName (SourceName (!!! "std") mempty) $ PrefixUQName uqn PrefixEnd+ UnscopedName (UnScName False uqn) -> Just $ PrefixUQName uqn PrefixEnd+ UnscopedName (UnScSubst s) -> Just $ PrefixUQName (StdSubst s) PrefixEnd+ UnscopedTemplateName nm _tmplArgs -> name2prefix nm+ LocalName _enc nm _disc -> name2prefix nm -- discriminators are invisible+ StringLitName _ _ -> Nothing+ nn2prefix = \case+ NestedName pf@(Prefix _) uqn _cvq _mbref ->+ case extendPrefix pf $ PrefixUQName uqn PrefixEnd of+ Prefix pfr -> Just pfr+ _ -> Nothing+ _ -> Nothing + substituteTemplatePrefix :: (Next Substitution TemplatePrefix) -> Next Substitution' TemplatePrefix substituteTemplatePrefix direct i =@@ -283,7 +331,7 @@ canSubstUnscopedTemplateName :: Next Name Name canSubstUnscopedTemplateName i = case i ^. nVal of- UnscopedName isStd uqn -> canSubst (SC_UQName isStd uqn) i+ UnscopedName (UnScName isStd uqn) -> canSubst (SC_UQName isStd uqn) i _ -> pure i @@ -304,6 +352,9 @@ canSubstTypes i = let subT i' ty = canSubst (SC_Type $ ty) i' in foldM subT i (i ^. nVal)++canSubstUnresolvedType :: Next UnresolvedType UnresolvedType+canSubstUnresolvedType i = canSubst (SC_UnresolvedType $ i ^. nVal) i canSubstTemplatePrefix :: Next TemplatePrefix TemplatePrefix canSubstTemplatePrefix i = canSubst (SC_TemplatePrefix $ i ^. nVal) i
test/Test.hs view
@@ -5,7 +5,9 @@ module Main (main) where +import Control.Monad ( unless ) import Control.Monad.Trans.State+import qualified Data.List.NonEmpty as NEL import Data.Text ( Text ) import qualified Data.Text as T import qualified Data.Text.IO as TIO@@ -17,7 +19,7 @@ import Test.Tasty.Hspec import Text.Sayable -import Demangler ( demangle, demangle1, newDemangling )+import Demangler ( demangle, demangle1, newDemangling, functionName ) -- n.b. Original conception was to use a Sandwich Context to retrieve the -- contents of the input data files, but a Context can only be retrieved (via@@ -32,35 +34,47 @@ defaultMain =<< (testSpec "Demangle" $ demangleTests inps) -getInputData :: String -> IO (String, [(Text, Text)])+getInputData :: String -> IO (String, [(Text, Text, [Text])]) getInputData fname = do inputs <- TIO.readFile fname expects <- T.pack <$> readProcess "c++filt" [] (T.unpack inputs)- let pairs = zip (T.lines inputs) (T.lines expects)- return (fname, pairs)+ funcNames <- fmap (T.splitOn (T.pack "`"))+ . T.lines+ <$> TIO.readFile (fname <> "-funcnames")+ let matches = zip3 (T.lines inputs) (T.lines expects) (funcNames <> repeat [])+ return (fname, matches) -demangleTests :: [(String, [(Text, Text)])] -> Spec+demangleTests :: [(String, [(Text, Text, [Text])])] -> Spec demangleTests testInputs = describe "Demangle tests" $ mapM_ demangleTestSet testInputs -demangleTestSet :: (String, [(Text, Text)]) -> Spec+demangleTestSet :: (String, [(Text, Text, [Text])]) -> Spec demangleTestSet (inpFile, inpData) = describe inpFile $- do describe "Individually" $ sequence_ (mkTest <$> inpData)+ do describe "Solo" $ sequence_ (mkTest <$> inpData) describe "Batched" $ batchTest inpData -mkTest :: (Text, Text) -> Spec-mkTest (sym, expected) = it ("demangles " <> T.unpack sym) $- (toText $ demangle1 sym) `shouldBe` expected+mkTest :: (Text, Text, [Text]) -> Spec+mkTest (sym, expected, funcNames) = describe (T.unpack sym) $ do+ let dm = demangle1 sym+ it "demangles" $ (toText $ dm) `shouldBe` expected+ unless (null funcNames || funcNames == [T.pack ""]) $+ it "gets functionName" $+ (NEL.toList <$> functionName dm) `shouldBe` Just funcNames -batchTest :: [(Text, Text)] -> Spec+batchTest :: [(Text, Text, [Text])] -> Spec batchTest symbols =- let r = runState (sequence (state . demangle . fst <$> symbols)) newDemangling- mkRes (dm, (inp, ex)) prs = (inp, toText (dm, snd r), ex) : prs+ let r = runState (sequence (state . demangle <$> syms)) newDemangling+ syms = (\(a,_,_) -> a) <$> symbols results = foldr mkRes [] $ zip (fst r) symbols- validate (i,rslt,e) = it ("demangles " <> T.unpack i) $ rslt `shouldBe` e+ mkRes (dm, (inp, ex, fne)) prs =+ (inp, toText (dm, snd r), ex, functionName (dm, snd r), fne) : prs+ validate (i,rslt,e,fn,fne) = do+ it ("demangles " <> T.unpack i) $ rslt `shouldBe` e+ unless (null fne || fne == [T.pack ""]) $+ it ("functionName " <> T.unpack i) $ (NEL.toList <$> fn) `shouldBe` Just fne in sequence_ (validate <$> results) toText :: Sayable "normal" a => a -> Text
+ test/full-test-cases.txt-funcnames view
test/initial-test-cases.txt view
@@ -47,3 +47,18 @@ _ZN17PositionSmoothing18_generateSetpointsERKN6matrix7Vector3IfEERA3_S3_bS4_fbRNS_26PositionSmoothingSetpointsE _ZN17PositionSmoothing18_generateSetpointsERKN6matrix7Vector3IfEERA_S3_bS4_fbRNS_26PositionSmoothingSetpointsE _ZZ23airship_att_recalibratevE4amsg+_ZNSt6vectorIN5boost10shared_ptrIN3ros12TimerManagerINS2_10SteadyTimeENS2_12WallDurationENS2_16SteadyTimerEventEE9TimerInfoEEESaIS9_EE17_M_realloc_insertIJRKS9_EEEvN9__gnu_cxx17__normal_iteratorIPS9_SB_EEDpOT_+_ZN5boost9function4IvRKNS_10shared_ptrIN3ros10ConnectionEEERKNS_12shared_arrayIhEEjbEC2INS_3_bi6bind_tIvNS_4_mfi3mf4IvNS2_22TransportPublisherLinkES6_SA_jbEENSD_5list5INSD_5valueIPSH_EENS_3argILi1EEENSN_ILi2EEENSN_ILi3EEENSN_ILi4EEEEEEEEET_NS_10enable_if_IXntsrNS_11is_integralISU_EE5valueEiE4typeE+_Z3fooIXtl7MyArrayLi1ELi2ELi3EEEEPKci+_Z3barIXcv7MyArrayilLi1ELi2ELi3EEEEPKci+_Z3bazIXtl1Xdi1adi1bdxLi3ELi1EEEEPKci+_ZZN15AP_MotorsMatrix21setup_octaquad_matrixEN9AP_Motors16motor_frame_typeEE6motors_5+_ZN3FooUt3_C2Ev+_ZN9AP_Logger4initERK9AP_ParamTIiL11ap_var_type3EEPK12LogStructureh+_ZL3MINIf9AP_ParamTIfL11ap_var_type4EEEDTqultfp_fp0_fp_fp0_ERKT_RKT0_+_ZN7FunctorIvJhbjEE4bindIN6AP_HAL9PWMSourceEXadL_ZNS3_11irq_handlerEhbjEEEES0_PT_+_ZN7FunctorIvJEE14method_wrapperIN13AP_Networking4PortEXadL_ZNS3_15tcp_client_loopEvEEEEvPv+_Z2sqIdJddEEdT_DpKT0_+_ZN6Canard11ObjCallbackI11AP_DroneCAN26com_hobbywing_esc_GetEscIDEC2EPS1_MS1_FvRK16CanardRxTransferRKS2_E+_ZNSt7complexIfEmIIfEERS0_RKS_IT_E+_ZNVK20AP_ESC_Telem_Backend13TelemetryData5staleEj
+ test/initial-test-cases.txt-funcnames view
@@ -0,0 +1,64 @@+qAllocMore+qHBNewFace+foobar+qAllocMore+qAllocMore+qAllocMore+qAllocMore+qAllocMore+read_gyro+uorb_unsubscribe`uorb++__const._Z23airship_att_recalibratev.amsg+operator|+operator&+operator&+qt_qFindChildren_helper+qUnregisterResourceData+qstricmp+foo`foo+vehicle_gps_stop+vehicle_gps_stop+vehicle_gps_start+vehicle_gps_town+vehicle_gps_town+hrt_tim_isr+publish`Publication`uORB+publish`Publication`uORB+Quaternion`Quaternion`matrix+operator[]`map`std+++operator+`std+fill_n`std+__copy_move_backward_a2`std+forward_as_tuple`std+forward`std+__ucr`__uninitialized_construct_buf_dispatch`std+operator<<`larcfm+qqq`kwq++drawItemText`QGtkStyle+~QTextEdit`QTextEdit+operator new+WorkQueueRunner`px4+get_socket_path`px4_daemon+get_socket_path`px4_daemon+_generateSetpoints`PositionSmoothing+_generateSetpoints`PositionSmoothing++_M_realloc_insert`vector`std+function4`function4`boost+foo+bar+baz+setup_octaquad_matrix`AP_MotorsMatrix+Foo`unnamed_type_num5`Foo+init`AP_Logger++bind`Functor+method_wrapper`Functor+sq+ObjCallback`ObjCallback`Canard+operator-=`complex`std+stale`TelemetryData`AP_ESC_Telem_Backend