packages feed

mangle (empty) → 0.1.0.1

raw patch · 8 files changed

+866/−0 lines, 8 filesdep +HUnitdep +basedep +containerssetup-changed

Dependencies added: HUnit, base, containers, fb-stubs, hspec, hspec-contrib, mangle, parsec, template-haskell

Files

+ CHANGELOG.md view
@@ -0,0 +1,9 @@+# Revision history for mangle++## 0.1.0.1++* Builds with GHC 9.8.x++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+BSD License++For hsthrift software++Copyright (c) Facebook, Inc. and its affiliates. 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 Facebook nor the names of its 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 HOLDER 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.
+ Main.hs view
@@ -0,0 +1,26 @@+{-+  Copyright (c) Meta Platforms, Inc. and affiliates.+  All rights reserved.++  This source code is licensed under the BSD-style license found in the+  LICENSE file in the root directory of this source tree.+-}++module Main (main) where++import System.Environment+import System.Exit hiding (die)+import System.IO++import Mangle++main :: IO ()+main = do+  args <- getArgs+  case args of+    [arg] -> either (die 1 . show) putStr $ mangle arg+    _ -> die 1 "Usage: mangle <signature>"++die :: Int -> String -> IO a+die exitCode msg =+  hPutStrLn stderr msg >> exitWith (ExitFailure exitCode)
+ Mangle.hs view
@@ -0,0 +1,496 @@+{-+  Copyright (c) Meta Platforms, Inc. and affiliates.+  All rights reserved.++  This source code is licensed under the BSD-style license found in the+  LICENSE file in the root directory of this source tree.+-}++{-# LANGUAGE ViewPatterns #-}++module Mangle+  ( mangle+  ) where++import Control.Arrow+import Control.Applicative hiding (Const)+import Control.Monad+import Data.Functor.Identity+import Data.Function+import Data.List+import Data.Maybe+import Data.Set (Set)+import Foreign.C+import Numeric+import Text.Parsec hiding ((<|>), many)++import qualified Data.Set as Set++-- | Mangles a C++ signature into a string.+mangle :: String -> Either ParseError String+mangle = fmap show . runParser sig (Uniq 0) ""++foreign export ccall itaniumMangle :: CString -> CSize -> IO CString+itaniumMangle :: CString -> CSize -> IO CString+itaniumMangle csymbol clen = do+  symbol <- peekCStringLen (csymbol, fromIntegral clen)+  either (\e -> fail $ "itaniumMangle failed: " ++ symbol ++ "\n" ++ show e)+         newCString+         (mangle symbol)++--------------------------------------------------------------------------------+-- Signatures+--+-- A signature consists of a name, a parameter list, and a set of+-- cv-qualifiers. The return type is parsed, but is not included in the mangled+-- name, so we don't store it.++data Sig = Sig Name [Type] (Set CV)++instance Show Sig where+  show (normalizeSig -> s@(Sig sigName params cv)) = concat+    $ "_Z"  -- All mangled symbols start this way.+    : showCvName cv sigName+    : if null params+      then [showType s (Builtin Void)]+      else map (showType s) params+    where+    -- cv-qualifiers aren't allowed on non-nested names in C++.+    showCvName _ (Unqual n _) = lengthPrefix n+    showCvName cvs (Qual names name _)+      = lengthEncode (showCvs cvs) "" (names ++ [name])++sig :: Parser Sig+sig = do+  spaces+  _ <- type_  -- Return type, ignored.+  id_ <- nestedId+  params_ <- list type_+  cvs <- opt cvQuals+  return $ Sig id_ params_ cvs++normalizeSig :: Sig -> Sig+normalizeSig (Sig name params cv) =+  Sig name (map normalizeParameterType params) cv++--------------------------------------------------------------------------------+-- Types++data Type+  = Builtin Builtin+  | Named Name (Maybe [Type]) Uniq+  | Ptr Type Uniq+  | Ref Type Uniq+  | CV (Set CV) Type Uniq+  deriving (Show)++instance Eq Type where+  Builtin a == Builtin b = a == b+  Named a b _ == Named c d _ = (a, b) == (c, d)+  Ptr a _ == Ptr b _ = a == b+  Ref a _ == Ref b _ = a == b+  CV a b _ == CV c d _ = (a, b) == (c, d)+  _ == _ = False++showType :: Sig -> Type -> String+showType s t = case t of+  Builtin b -> show b+  Named name args _ -> (showName name args' `fromMaybe` findName name args)+    where args' = maybe "" (("I" ++) . (++ "E") . concatMap recur) args+  Ptr t' u -> fromMaybe ("P" ++ recur t') (findType t u)+  Ref t' u -> fromMaybe ("R" ++ recur t') (findType t u)+  CV cvs t' u -> fromMaybe (showCvs cvs ++ recur t') (findType t u)+  where+  recur = showType s++  findType t' u = search byType id+    where+    byType match (TypeSub t'')+      = t' == t'' && maybe False (match u) (typeUniq t'')+    byType _ _ = False++  findName (Qual names name u) args = byName <|> byQual+    where+    byName = search byName' id+    byQual = search byQual'+      $ \i -> concat ["N", i, lengthPrefix name, "E"]+    byName' match (NameSub names' args' u')+      = and [names ++ [name] == names', match u u', args == args']+    byName' _ _ = False+    byQual' match (QualSub names' u')+      = names == names' && match u u'+    byQual' _ _ = False++  findName (Unqual name u) args = search byName id+    where+    byName match (NameSub names' args' u')+      = and [[name] == names', match u u', args == args']+    byName _ _ = False++  search by f = do+    -- Find a component that is equal but elsewhere.+    i <- subIndex (by (/=)) s+    -- Ensure it occurs before this one.+    guard $ i `before` subIndex (by (==)) s+    return $ f (show i)++  _ `before` Nothing = True+  i `before` Just i' = i < i'++type_ :: Parser Type+type_ = do+  -- cv-qualifiers may occur before or after base types.+  cv1 <- opt cvQuals+  id_ <- typeId+  mods <- many $ ref <|> ((\q u t -> mkCv q t u) <$> cvQuals <*> genUniq)+  u <- genUniq+  return $ foldr ($) (mkCv cv1 id_ u) (reverse mods)++typeId :: Parser Type+typeId = do+  qual <- typeQual+  parts <- if null qual+    then idParts+    else do+      ps <- optionMaybe ((:[]) <$> qualifiable)+      return $ flip fromMaybe ps $ case qual of+        -- long is a qualifier as well as a end value itself+        ["long"] -> []+        _ -> ["int"]+  args <- optionMaybe templateArgs+  case maybeBuiltin (sortBy (flip compare) $ qual ++ parts) of+    Just builtin -> return $ Builtin builtin+    -- TODO: Perhaps verify that 'qual' is empty if not used.+    Nothing -> Named <$> (case parts of+      [] -> error "empty identifier"+      [part] -> Unqual part <$> genUniq+      _ -> Qual (init parts) (last parts) <$> genUniq) <*> pure args <*> genUniq++typeQual :: Parser [String]+typeQual = fmap (sortBy $ flip compare)+  . many . choice $ map word ["long", "unsigned", "signed"]++templateArgs :: Parser [Type]+templateArgs = between (word "<") (word ">") (commas type_)++qualifiable :: Parser String+qualifiable = choice $ map word+  ["char", "int", "__int64", "__int128"]++ref :: Parser (Type -> Type)+ref = flip <$> (Ptr <$ word "*" <|> Ref <$ word "&") <*> genUniq++-- From the itanium ABI spec:+-- "Note that top-level cv-qualifiers specified on a parameter type do+-- not affect the function type directly (i.e., int(*)(T) and int(*)(T+-- const) are the same type)"+normalizeParameterType :: Type -> Type+normalizeParameterType t = case normalizeType t of+  CV _ t' _ -> t'+  other -> other++normalizeType :: Type -> Type+normalizeType t = case t of+  Builtin{} -> t+  Named name args u -> Named name (map normalizeType <$> args) u+  Ptr t' u -> Ptr (normalizeType t') u+  Ref t' u -> Ref (normalizeType t') u+  CV cvs t' _ | Set.null cvs -> normalizeType t'+  CV cvs (CV cvs' t' _) u -> normalizeType $ CV (cvs <> cvs') t' u+  CV cvs t' u -> CV cvs (normalizeType t') u++--------------------------------------------------------------------------------+-- Names++data Name = Qual [String] String Uniq | Unqual String Uniq+  deriving (Show)++instance Eq Name where+  Qual a b _ == Qual c d _ = (a, b) == (c, d)+  Unqual a _ == Unqual b _ = a == b+  _ == _ = False++idParts :: Parser [String]+idParts = do+  skipMany (word "::") -- possible leading "::"+  rawId `sepBy1` word "::"++showName :: Name -> String -> String+showName (Unqual name _) args = lengthEncode "" args [name]+showName (Qual names name _) args = lengthEncode "" args (names ++ [name])++lengthEncode :: String -> String -> [String] -> String+lengthEncode cvs args = \case+  ["std", "allocator"] -> "Sa"+  ["std", "basic_string"] -> "Sb" ++ args+  ["std", "string"] -> "Ss"+  ["std", "istream"] -> "Si"+  ["std", "ostream"] -> "So"+  ["std", "iostream"] -> "Sd"+  ["std", "size_t"] -> "m"+  ["std", name] -> "St" ++ lengthPrefix name ++ args+  "std":names -> concat ["NSt", concatMap lengthPrefix names, args, "E"]+  [name] -> lengthPrefix name ++ args+  names -> concat ["N", cvs, concatMap lengthPrefix names, args, "E"]++lengthPrefix :: String -> String+lengthPrefix = uncurry (++) . (show . length &&& id)++nestedId :: Parser Name+nestedId = do+  parts <- idParts+  (case parts of+    [part] -> Unqual part+    _ -> Qual (init parts) (last parts)) <$> genUniq++rawId :: Parser String+rawId = notFollowedBy cvQual *> lexeme+  (liftA2 (:) nondigit (many $ nondigit <|> digit) <?> "identifier")++nondigit :: Parser Char+nondigit = letter <|> char '_'++--------------------------------------------------------------------------------+-- Substitutions+--+-- Symbols are compressed by allowing signature components to refer to prior+-- components in the signature.++data Sub+  = QualSub [String] Uniq+  | NameSub [String] (Maybe [Type]) Uniq+  | TypeSub Type+  deriving (Eq, Show)++subIndex :: (Sub -> Bool) -> Sig -> Maybe Index+subIndex f = fmap Index . findIndex f . nubBy ((==) `on` ignoreUniq) . sigSubs+  where+  ignoreUniq (QualSub names _) = QualSub names $ Uniq 0+  ignoreUniq (NameSub names name _) = NameSub names name $ Uniq 0+  ignoreUniq t = t+  -- 'nub' because substitutions are not repeated.++-- Note that the whole nested name from a signature is not considered for+-- substitution, only its prefix.+sigSubs :: Sig -> [Sub]+sigSubs (Sig Unqual{} types _)+  = concatMap typeSubs types+sigSubs (Sig (Qual names _ u) types _)+  =  [QualSub nss u | nss <- tail $ inits names]+  ++ concatMap typeSubs types++typeSubs :: Type -> [Sub]+typeSubs Builtin{} = []+typeSubs (Named (Unqual name u) args _)+  = NameSub [name] Nothing u+  : [NameSub [name] args u | isJust args]+typeSubs (Named (Qual names name u) args _)+  =  [QualSub nss u | nss <- tail $ inits names]+  ++ [NameSub names' Nothing u]+  ++ [NameSub names' args u | isJust args]+  where+  names' = names ++ [name]+typeSubs t@(Ptr t' _) = typeSubs t' ++ [TypeSub t]+typeSubs t@(Ref t' _) = typeSubs t' ++ [TypeSub t]+typeSubs t@(CV _ t' _) = typeSubs t' ++ [TypeSub t]++--------------------------------------------------------------------------------+-- Substitution indices+--+-- Backreferences to substitutions are mangled in base 36.++newtype Index = Index Int+  deriving (Bounded, Eq, Ord)++instance Show Index where+  show (Index 0) = "S_"+  show (Index n) = "S" ++ showIntAtBase 36 c (n - 1) "_"+    where+    c x = toEnum $ if x >= 0 && x <= 9+      then fromEnum '0' + x+      else fromEnum 'A' + (x - 10)++--------------------------------------------------------------------------------+-- cv-qualifiers+--+-- cv-qualifiers are ordered and deduplicated, so we store them in sets.++data CV = Volatile | Restrict | Const+  deriving (Eq, Ord)++instance Show CV where+  show = \case+    Const -> "K"+    Restrict -> "r"+    Volatile -> "V"++constQual :: Parser CV+constQual = Const <$ word "const"++cvQuals :: Parser (Set CV)+cvQuals = Set.fromList <$> many1 cvQual++cvQual :: Parser CV+cvQual = choice [constQual, volatileQual, restrictQual]++mkCv :: Set CV -> Type -> Uniq -> Type+mkCv cvs (CV cvs' t _) u = CV (cvs <> cvs') t u+mkCv cvs t u = CV cvs t u++-- Basically unnecessary.+restrictQual :: Parser CV+restrictQual = Restrict <$ word "restrict"++showCvs :: Set CV -> String+showCvs = concatMap show . Set.toList++volatileQual :: Parser CV+volatileQual = Volatile <$ word "volatile"++--------------------------------------------------------------------------------+-- Unique tags+--+-- When compressing a symbol, we do a depth-first pre-order traversal of the+-- signature AST. We don't want to substitute a type with a reference to itself,+-- so we give each type a unique tag.++newtype Uniq = Uniq Int+  deriving (Enum, Eq, Show)++genUniq :: Parser Uniq+genUniq = do+  next <- getState+  modifyState succ+  return next++typeUniq :: Type -> Maybe Uniq+typeUniq Builtin{} = Nothing+typeUniq (Named _ _ u) = Just u+typeUniq (Ptr _ u) = Just u+typeUniq (Ref _ u) = Just u+typeUniq (CV _ _ u) = Just u++--------------------------------------------------------------------------------+-- Parser utilities+--+-- Parsec's user state is used to generate unique tags for types. See 'Uniq'.++type Parser a = ParsecT String Uniq Identity a++commas :: Parser a -> Parser [a]+commas = (`sepEndBy` word ",")++list :: Parser a -> Parser [a]+list = paren . commas++lexeme :: Parser String -> Parser String+lexeme = (<* spaces)++opt :: (Monoid a) => Parser a -> Parser a+opt = option mempty++paren :: Parser a -> Parser a+paren = between (word "(") (word ")")++word :: String -> Parser String+word = try . lexeme . string++--------------------------------------------------------------------------------+-- Builtins+--+-- Builtin types are mangled differently from user-defined types.++data Builtin+  = Void+  | WChar+  | Bool+  | Char+  | SChar+  | UChar+  | Short+  | UShort+  | Int+  | UInt+  | Long+  | ULong+  | LongLong+  | ULongLong+  | LongLongLong+  | ULongLongLong+  | Float+  | Double+  | LongDouble+  | LongLongDouble+  | Char32+  | Char16+  deriving (Eq)++instance Show Builtin where+  show = \case+    Void -> "v"+    WChar -> "w"+    Bool -> "b"+    Char -> "c"+    SChar -> "a"+    UChar -> "h"+    Short -> "s"+    UShort -> "t"+    Int -> "i"+    UInt -> "j"+    Long -> "l"+    ULong -> "m"+    LongLong -> "x"+    ULongLong -> "y"+    LongLongLong -> "n"+    ULongLongLong -> "o"+    Float -> "f"+    Double -> "d"+    LongDouble -> "e"+    LongLongDouble -> "g"+    Char32 -> "Di"+    Char16 -> "Ds"++maybeBuiltin :: [String] -> Maybe Builtin+maybeBuiltin = \case+  ["void"] -> Just Void+  ["wchar_t"] -> Just WChar+  ["bool"] -> Just Bool+  ["char"] -> Just Char+  -- WTB disjunctive patterns.+  ["signed", "char"] -> Just SChar+  ["int8_t"] -> Just SChar+  ["unsigned", "char"] -> Just UChar+  ["uint8_t"] -> Just UChar+  ["short"] -> Just Short+  ["short", "int"] -> Just Short+  ["int16_t"] -> Just Short+  ["unsigned", "short"] -> Just UShort+  ["unsigned", "short", "int"] -> Just UShort+  ["uint16_t"] -> Just UShort+  ["int"] -> Just Int+  ["int32_t"] -> Just Int+  ["unsigned"] -> Just UInt+  ["unsigned", "int"] -> Just UInt+  ["uint32_t"] -> Just UInt+  ["long"] -> Just Long+  ["int64_t"] -> Just Long+  ["unsigned", "long"] -> Just ULong+  ["unsigned", "long", "int"] -> Just ULong+  ["uint64_t"] -> Just ULong+  ["size_t"] -> Just ULong+  ["long", "long"] -> Just LongLong+  ["long", "long", "int"] -> Just LongLong+  ["__int64"] -> Just LongLong+  ["unsigned", "long", "long"] -> Just ULongLong+  ["unsigned", "long", "long", "int"] -> Just ULongLong+  ["unsigned", "__int64"] -> Just ULongLong+  ["__int128"] -> Just LongLongLong+  ["unsigned", "__int128"] -> Just ULongLongLong+  ["float"] -> Just Float+  ["double"] -> Just Double+  ["long", "double"] -> Just LongDouble+  ["__float80"] -> Just LongDouble+  ["__float128"] -> Just LongLongDouble+  ["char32_t"] -> Just Char32+  ["char16_t"] -> Just Char16+  _ -> Nothing
+ Mangle/TH.hs view
@@ -0,0 +1,23 @@+{-+  Copyright (c) Meta Platforms, Inc. and affiliates.+  All rights reserved.++  This source code is licensed under the BSD-style license found in the+  LICENSE file in the root directory of this source tree.+-}++module Mangle.TH ( mangle ) where++import qualified Mangle+import Language.Haskell.TH++mangle :: String -> Q [Dec] -> Q [Dec]+mangle sig decls = do+  mangled <- case Mangle.mangle sig of+    Left err -> fail (show err)+    Right mangled -> return mangled+  let+    mangleForeign (ForeignD (ImportF conv safety _ name ty)) = do+      return $ ForeignD (ImportF conv safety mangled name ty)+    mangleForeign other = return other+  mapM mangleForeign =<< decls
+ Setup.hs view
@@ -0,0 +1,5 @@+-- Copyright (c) Facebook, Inc. and its affiliates.++-- @nolint+import Distribution.Simple+main = defaultMain
+ mangle.cabal view
@@ -0,0 +1,78 @@+cabal-version:       3.6++-- Copyright (c) Facebook, Inc. and its affiliates.++name:                mangle+version:             0.1.0.1+synopsis:            Convert C++ type signatures to their mangled form+homepage:            https://github.com/facebookincubator/hsthrift+bug-reports:         https://github.com/facebookincubator/hsthrift/issues+license:             BSD-3-Clause+license-file:        LICENSE+author:              Facebook, Inc.+maintainer:          hsthrift-team@fb.com+copyright:           (c) Facebook, All Rights Reserved+category:            FFI+build-type:          Simple+extra-doc-files:     CHANGELOG.md++description:+    Converts C++ type signatures to mangled symbol names.+    This is useful for calling C++ functions via the FFI without using+    @extern \"C\" { .. }@.++    The library can be used with Template Haskell, so you can call C+++    code directly from Haskell, e.g.++    @+    {-# LANGUAGE TemplateHaskell #-}+    ...+    import Mangle.TH+    ...+    $(mangle+      "void glog_info(const char*, int, const char*)"+      [d|+        foreign import ccall+          c_glog_info :: CString -> CInt -> CString -> IO ()+      |])+    @++source-repository head+    type: git+    location: https://github.com/facebookincubator/hsthrift.git++library+  exposed-modules:     Mangle, Mangle.TH+  default-extensions:  LambdaCase, GeneralizedNewtypeDeriving+  build-depends:+      base >=4.11.1.0 && <4.20,+      containers >=0.5.11.0 && <0.7,+      parsec ^>=3.1.13.0,+      template-haskell >=2.13 && <2.22+  default-language:    Haskell2010++executable mangle+  main-is:             Main.hs+  other-modules:       Mangle+  default-extensions:  LambdaCase, GeneralizedNewtypeDeriving+  build-depends:+      base >=4.11.1 && <4.20,+      containers >=0.5.11 && <0.7,+      parsec ^>=3.1.13.0,+      template-haskell >=2.13 && <2.22+  default-language:    Haskell2010++test-suite mangle-test+  type: exitcode-stdio-1.0+  hs-source-dirs: tests+  default-language: Haskell2010+  default-extensions: LambdaCase+  main-is: Test.hs+  build-depends:+      base,+      fb-stubs,+      hspec,+      hspec-contrib,+      mangle,+      HUnit ^>= 1.6.1+  ghc-options: -threaded -main-is Test
+ tests/Test.hs view
@@ -0,0 +1,199 @@+{-+  Copyright (c) Meta Platforms, Inc. and affiliates.+  All rights reserved.++  This source code is licensed under the BSD-style license found in the+  LICENSE file in the root directory of this source tree.+-}++module Test where++import Test.HUnit+import TestRunner++import Mangle++main :: IO ()+main = testRunner tests++tests :: Test+tests = TestList $ map (uncurry3 assertMangle)+  [ eg "simple"+    "_Z7examplei"+    "int example(int)"++  , eg "void"+    "_Z7examplev"+    "int example(void)"++  , eg "implicitly void"+    "_Z7examplev"+    "int example()"++  , eg "simple cv"+    "_Z7examplePKc"+    "int example(const char*)"++  , eg "qualifiers"+    "_Z7examplej"+    "void example(unsigned int)"++  , eg "qualifier ordering"+    "_Z7examplem"+    "void example(long unsigned int)"++  , eg "qualifier without type"+    "_Z7examplej"+    "void example(unsigned)"++  , eg "qualifiers without type"+    "_Z7examplem"+    "void example(unsigned long)"++  , eg "long as singular argument"+    "_Z7examplel"+    "void example(long)"++  , eg "doubled qualifiers"+    "_Z7exampley"+    "void example(unsigned long long int)"++  , eg "multiple cv"+    "_Z7examplePVKi"+    "int example(const int volatile*)"++  , eg "multiple cv order"+    "_Z7examplePVKi"+    "int example(volatile int const*)"++  , eg "qualified name"+    "_ZN5Class8functionEi"+    "int Class::function(int)"++  , eg "multiple qualified names"+    "_ZN2ns5Class8functionERKN5other5thingEi"+    "int ns::Class::function(const other::thing&, int)"++  , eg "std::string"+    "_Z7exampleRKSs"+    "void example(const std::string&)"++  , eg "std::shared_ptr"+    "_Z7exampleSt10shared_ptrIiE"+    "void example(std::shared_ptr<int>)"++  , eg "boost::shared_ptr"+    "_Z7exampleN5boost10shared_ptrIiEE"+    "void example(boost::shared_ptr<int>)"++  , eg "unqualified templated names"+    "_Z7example7MyClassIiiE"+    "void example(MyClass<int,int>)"++  , eg "double pointer"+    "_Z7examplePPc"+    "void example(char**)"++  , eg "double pointer with cv"+    "_Z7examplePKPKc"+    "void example(const char* const*)"++  , eg "reference"+    "_Z7exampleRm"+    "void example(unsigned long&)"++  , eg "member function cv"+    "_ZNK3Foo10frobnicateEv"+    "void Foo::frobnicate() const"++  , eg "simple substitution"+    "_Z7example3fooS_"+    "void example(foo, foo)"++  , eg "simple builtin substitution"+    "_Z7examplePKcS0_"+    "void example(const char*, const char*)"++  , eg "no substitution of base types"+    "_Z7examplemm"+    "void example(unsigned long, unsigned long)"++  , eg "internal substitution"+    "_Z7examplePKcPKS0_"+    "void example(const char*, const char* const*)"++  , eg "internal substitution with skipping"+    "_Z7examplemPPmS_"+    "void example(uint64_t, uint64_t**, uint64_t*)"++  , eg "multiple substitutions"+    "_Z7examplePKcS0_PKS0_"+    "void example(const char*, const char*, const char* const*)"++  , eg "multiple substitutions in nested name (not monotonic)"+    "_ZNK6nested7exampleEmPKPKmS1_"+    "void nested::example(uint64_t, uint64_t const* const*, uint64_t const*) const"++  , eg "substitution in nested name"+    "_ZN6nested7exampleEPKcS1_"+    "void nested::example(const char*, const char*)"++  , eg "substitution of prefix"+    "_ZN6nested7exampleENS_5thingE"+    "void nested::example(nested::thing)"++  , eg "substitution of whole nested name"+    "_Z7exampleN6nested5thingES0_"+    "void example(nested::thing, nested::thing)"++  , eg "substitution of nested namespaces"+    "_ZN2fb2hs7exampleENS_1AEPKS1_NS0_1BES3_"+    "void fb::hs::example(fb::A, const fb::A*, fb::hs::B, fb::A const*)"++  -- TODO(watashi): t9761416 make following tests pass+  -- , eg "substitution of std"+  --   "_ZSt7exampleNSt3std1AES0_NS_3stdE"+  --   "void std::example(std::A, std::std::A, std::std::std)"++  , eg "substitution of types with qualifiers"+     "_Z7example1AS_PS_PKS_S2_S0_"+     "void example(A, const A, A*, const A*, A const*, A* const)"++  -- , eg "substitution of partial namespaces"+  --   "_Z7exampleN6outter1AENS_5inner1AENS_1BENS1_1BE"+  --   "void example(outter::A, outter::inner::A, outter::B, outter::inner::B)"++  , eg "leading :: in namespace specification"+    "_ZN2fb7exampleENS_1AES0_"+    "void fb::example(::fb::A, fb::A)"++  , eg "std::size_t"+    "_Z13c_get_counterPN1A1B1CEPKcm"+    "int64_t c_get_counter(A::B::C*, const char*, std::size_t)"++  , eg "compression"+    "_ZN8facebook2hs16readDynamicArrayEPKN5folly7dynamicEmPS4_"+    "int facebook::hs::readDynamicArray(const folly::dynamic*, size_t, const folly::dynamic**)"+  ]+  where+    eg = (,,)+    uncurry3 f (a, b, c) = f a b c++assertRight :: (Show a, Show b, Eq b) => String -> b -> Either a b -> Assertion+assertRight prefix expected actual+  = assertBool message $ rightly expected actual+  where+  message = concat+    [ prefix+    , ": expected "+    , show expected+    , " but got "+    , show actual+    ]++rightly :: (Eq b) => b -> Either a b -> Bool+rightly = either (const False) . (==)++assertMangle :: String -> String -> String -> Test+assertMangle prefix expected+  = TestLabel prefix . TestCase . assertRight prefix expected . mangle