{-
  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 :: String -> Either ParseError String
mangle = (Sig -> String)
-> Either ParseError Sig -> Either ParseError String
forall a b. (a -> b) -> Either ParseError a -> Either ParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sig -> String
forall a. Show a => a -> String
show (Either ParseError Sig -> Either ParseError String)
-> (String -> Either ParseError Sig)
-> String
-> Either ParseError String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String Uniq Sig
-> Uniq -> String -> String -> Either ParseError Sig
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec String Uniq Sig
sig (Int -> Uniq
Uniq Int
0) String
""

foreign export ccall itaniumMangle :: CString -> CSize -> IO CString
itaniumMangle :: CString -> CSize -> IO CString
itaniumMangle :: CString -> CSize -> IO CString
itaniumMangle CString
csymbol CSize
clen = do
  String
symbol <- CStringLen -> IO String
peekCStringLen (CString
csymbol, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
clen)
  (ParseError -> IO CString)
-> (String -> IO CString) -> Either ParseError String -> IO CString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParseError
e -> String -> IO CString
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO CString) -> String -> IO CString
forall a b. (a -> b) -> a -> b
$ String
"itaniumMangle failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
symbol String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
e)
         String -> IO CString
newCString
         (String -> Either ParseError String
mangle String
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 :: Sig -> String
show (Sig -> Sig
normalizeSig -> s :: Sig
s@(Sig Name
sigName [Type]
params Set CV
cv)) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"_Z"  -- All mangled symbols start this way.
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Set CV -> Name -> String
showCvName Set CV
cv Name
sigName
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: if [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
params
      then [Sig -> Type -> String
showType Sig
s (Builtin -> Type
Builtin Builtin
Void)]
      else (Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Sig -> Type -> String
showType Sig
s) [Type]
params
    where
    -- cv-qualifiers aren't allowed on non-nested names in C++.
    showCvName :: Set CV -> Name -> String
showCvName Set CV
_ (Unqual String
n Uniq
_) = String -> String
lengthPrefix String
n
    showCvName Set CV
cvs (Qual [String]
names String
name Uniq
_)
      = String -> String -> [String] -> String
lengthEncode (Set CV -> String
showCvs Set CV
cvs) String
"" ([String]
names [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
name])

sig :: Parser Sig
sig :: Parsec String Uniq Sig
sig = do
  ParsecT String Uniq Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Type
_ <- Parser Type
type_  -- Return type, ignored.
  Name
id_ <- Parser Name
nestedId
  [Type]
params_ <- Parser Type -> Parser [Type]
forall a. Parser a -> Parser [a]
list Parser Type
type_
  Set CV
cvs <- Parser (Set CV) -> Parser (Set CV)
forall a. Monoid a => Parser a -> Parser a
opt Parser (Set CV)
cvQuals
  Sig -> Parsec String Uniq Sig
forall a. a -> ParsecT String Uniq Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> Parsec String Uniq Sig) -> Sig -> Parsec String Uniq Sig
forall a b. (a -> b) -> a -> b
$ Name -> [Type] -> Set CV -> Sig
Sig Name
id_ [Type]
params_ Set CV
cvs

normalizeSig :: Sig -> Sig
normalizeSig :: Sig -> Sig
normalizeSig (Sig Name
name [Type]
params Set CV
cv) =
  Name -> [Type] -> Set CV -> Sig
Sig Name
name ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
normalizeParameterType [Type]
params) Set CV
cv

--------------------------------------------------------------------------------
-- Types

data Type
  = Builtin Builtin
  | Named Name (Maybe [Type]) Uniq
  | Ptr Type Uniq
  | Ref Type Uniq
  | CV (Set CV) Type Uniq
  deriving (Int -> Type -> String -> String
[Type] -> String -> String
Type -> String
(Int -> Type -> String -> String)
-> (Type -> String) -> ([Type] -> String -> String) -> Show Type
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Type -> String -> String
showsPrec :: Int -> Type -> String -> String
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> String -> String
showList :: [Type] -> String -> String
Show)

instance Eq Type where
  Builtin Builtin
a == :: Type -> Type -> Bool
== Builtin Builtin
b = Builtin
a Builtin -> Builtin -> Bool
forall a. Eq a => a -> a -> Bool
== Builtin
b
  Named Name
a Maybe [Type]
b Uniq
_ == Named Name
c Maybe [Type]
d Uniq
_ = (Name
a, Maybe [Type]
b) (Name, Maybe [Type]) -> (Name, Maybe [Type]) -> Bool
forall a. Eq a => a -> a -> Bool
== (Name
c, Maybe [Type]
d)
  Ptr Type
a Uniq
_ == Ptr Type
b Uniq
_ = Type
a Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
b
  Ref Type
a Uniq
_ == Ref Type
b Uniq
_ = Type
a Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
b
  CV Set CV
a Type
b Uniq
_ == CV Set CV
c Type
d Uniq
_ = (Set CV
a, Type
b) (Set CV, Type) -> (Set CV, Type) -> Bool
forall a. Eq a => a -> a -> Bool
== (Set CV
c, Type
d)
  Type
_ == Type
_ = Bool
False

showType :: Sig -> Type -> String
showType :: Sig -> Type -> String
showType Sig
s Type
t = case Type
t of
  Builtin Builtin
b -> Builtin -> String
forall a. Show a => a -> String
show Builtin
b
  Named Name
name Maybe [Type]
args Uniq
_ -> (Name -> String -> String
showName Name
name String
args' String -> Maybe String -> String
forall a. a -> Maybe a -> a
`fromMaybe` Name -> Maybe [Type] -> Maybe String
findName Name
name Maybe [Type]
args)
    where args' :: String
args' = String -> ([Type] -> String) -> Maybe [Type] -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
"I" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> ([Type] -> String) -> [Type] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"E") (String -> String) -> ([Type] -> String) -> [Type] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> String) -> [Type] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> String
recur) Maybe [Type]
args
  Ptr Type
t' Uniq
u -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String
"P" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
recur Type
t') (Type -> Uniq -> Maybe String
findType Type
t Uniq
u)
  Ref Type
t' Uniq
u -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String
"R" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
recur Type
t') (Type -> Uniq -> Maybe String
findType Type
t Uniq
u)
  CV Set CV
cvs Type
t' Uniq
u -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Set CV -> String
showCvs Set CV
cvs String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
recur Type
t') (Type -> Uniq -> Maybe String
findType Type
t Uniq
u)
  where
  recur :: Type -> String
recur = Sig -> Type -> String
showType Sig
s

  findType :: Type -> Uniq -> Maybe String
findType Type
t' Uniq
u = ((Uniq -> Uniq -> Bool) -> Sub -> Bool)
-> (String -> String) -> Maybe String
forall {a} {b}.
Eq a =>
((a -> a -> Bool) -> Sub -> Bool) -> (String -> b) -> Maybe b
search (Uniq -> Uniq -> Bool) -> Sub -> Bool
byType String -> String
forall a. a -> a
id
    where
    byType :: (Uniq -> Uniq -> Bool) -> Sub -> Bool
byType Uniq -> Uniq -> Bool
match (TypeSub Type
t'')
      = Type
t' Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t'' Bool -> Bool -> Bool
&& Bool -> (Uniq -> Bool) -> Maybe Uniq -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Uniq -> Uniq -> Bool
match Uniq
u) (Type -> Maybe Uniq
typeUniq Type
t'')
    byType Uniq -> Uniq -> Bool
_ Sub
_ = Bool
False

  findName :: Name -> Maybe [Type] -> Maybe String
findName (Qual [String]
names String
name Uniq
u) Maybe [Type]
args = Maybe String
byName Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
byQual
    where
    byName :: Maybe String
byName = ((Uniq -> Uniq -> Bool) -> Sub -> Bool)
-> (String -> String) -> Maybe String
forall {a} {b}.
Eq a =>
((a -> a -> Bool) -> Sub -> Bool) -> (String -> b) -> Maybe b
search (Uniq -> Uniq -> Bool) -> Sub -> Bool
byName' String -> String
forall a. a -> a
id
    byQual :: Maybe String
byQual = ((Uniq -> Uniq -> Bool) -> Sub -> Bool)
-> (String -> String) -> Maybe String
forall {a} {b}.
Eq a =>
((a -> a -> Bool) -> Sub -> Bool) -> (String -> b) -> Maybe b
search (Uniq -> Uniq -> Bool) -> Sub -> Bool
byQual'
      ((String -> String) -> Maybe String)
-> (String -> String) -> Maybe String
forall a b. (a -> b) -> a -> b
$ \String
i -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"N", String
i, String -> String
lengthPrefix String
name, String
"E"]
    byName' :: (Uniq -> Uniq -> Bool) -> Sub -> Bool
byName' Uniq -> Uniq -> Bool
match (NameSub [String]
names' Maybe [Type]
args' Uniq
u')
      = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [[String]
names [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
name] [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
names', Uniq -> Uniq -> Bool
match Uniq
u Uniq
u', Maybe [Type]
args Maybe [Type] -> Maybe [Type] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [Type]
args']
    byName' Uniq -> Uniq -> Bool
_ Sub
_ = Bool
False
    byQual' :: (Uniq -> Uniq -> Bool) -> Sub -> Bool
byQual' Uniq -> Uniq -> Bool
match (QualSub [String]
names' Uniq
u')
      = [String]
names [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
names' Bool -> Bool -> Bool
&& Uniq -> Uniq -> Bool
match Uniq
u Uniq
u'
    byQual' Uniq -> Uniq -> Bool
_ Sub
_ = Bool
False

  findName (Unqual String
name Uniq
u) Maybe [Type]
args = ((Uniq -> Uniq -> Bool) -> Sub -> Bool)
-> (String -> String) -> Maybe String
forall {a} {b}.
Eq a =>
((a -> a -> Bool) -> Sub -> Bool) -> (String -> b) -> Maybe b
search (Uniq -> Uniq -> Bool) -> Sub -> Bool
byName String -> String
forall a. a -> a
id
    where
    byName :: (Uniq -> Uniq -> Bool) -> Sub -> Bool
byName Uniq -> Uniq -> Bool
match (NameSub [String]
names' Maybe [Type]
args' Uniq
u')
      = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [[String
name] [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
names', Uniq -> Uniq -> Bool
match Uniq
u Uniq
u', Maybe [Type]
args Maybe [Type] -> Maybe [Type] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [Type]
args']
    byName Uniq -> Uniq -> Bool
_ Sub
_ = Bool
False

  search :: ((a -> a -> Bool) -> Sub -> Bool) -> (String -> b) -> Maybe b
search (a -> a -> Bool) -> Sub -> Bool
by String -> b
f = do
    -- Find a component that is equal but elsewhere.
    Index
i <- (Sub -> Bool) -> Sig -> Maybe Index
subIndex ((a -> a -> Bool) -> Sub -> Bool
by a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) Sig
s
    -- Ensure it occurs before this one.
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Index
i Index -> Maybe Index -> Bool
forall {a}. Ord a => a -> Maybe a -> Bool
`before` (Sub -> Bool) -> Sig -> Maybe Index
subIndex ((a -> a -> Bool) -> Sub -> Bool
by a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)) Sig
s
    b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ String -> b
f (Index -> String
forall a. Show a => a -> String
show Index
i)

  a
_ before :: a -> Maybe a -> Bool
`before` Maybe a
Nothing = Bool
True
  a
i `before` Just a
i' = a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
i'

type_ :: Parser Type
type_ :: Parser Type
type_ = do
  -- cv-qualifiers may occur before or after base types.
  Set CV
cv1 <- Parser (Set CV) -> Parser (Set CV)
forall a. Monoid a => Parser a -> Parser a
opt Parser (Set CV)
cvQuals
  Type
id_ <- Parser Type
typeId
  [Type -> Type]
mods <- ParsecT String Uniq Identity (Type -> Type)
-> ParsecT String Uniq Identity [Type -> Type]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String Uniq Identity (Type -> Type)
 -> ParsecT String Uniq Identity [Type -> Type])
-> ParsecT String Uniq Identity (Type -> Type)
-> ParsecT String Uniq Identity [Type -> Type]
forall a b. (a -> b) -> a -> b
$ ParsecT String Uniq Identity (Type -> Type)
ref ParsecT String Uniq Identity (Type -> Type)
-> ParsecT String Uniq Identity (Type -> Type)
-> ParsecT String Uniq Identity (Type -> Type)
forall a.
ParsecT String Uniq Identity a
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\Set CV
q Uniq
u Type
t -> Set CV -> Type -> Uniq -> Type
mkCv Set CV
q Type
t Uniq
u) (Set CV -> Uniq -> Type -> Type)
-> Parser (Set CV)
-> ParsecT String Uniq Identity (Uniq -> Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Set CV)
cvQuals ParsecT String Uniq Identity (Uniq -> Type -> Type)
-> ParsecT String Uniq Identity Uniq
-> ParsecT String Uniq Identity (Type -> Type)
forall a b.
ParsecT String Uniq Identity (a -> b)
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String Uniq Identity Uniq
genUniq)
  Uniq
u <- ParsecT String Uniq Identity Uniq
genUniq
  Type -> Parser Type
forall a. a -> ParsecT String Uniq Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Parser Type) -> Type -> Parser Type
forall a b. (a -> b) -> a -> b
$ ((Type -> Type) -> Type -> Type) -> Type -> [Type -> Type] -> Type
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
($) (Set CV -> Type -> Uniq -> Type
mkCv Set CV
cv1 Type
id_ Uniq
u) ([Type -> Type] -> [Type -> Type]
forall a. [a] -> [a]
reverse [Type -> Type]
mods)

typeId :: Parser Type
typeId :: Parser Type
typeId = do
  [String]
qual <- Parser [String]
typeQual
  [String]
parts <- if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
qual
    then Parser [String]
idParts
    else do
      Maybe [String]
ps <- Parser [String] -> ParsecT String Uniq Identity (Maybe [String])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ((String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String])
-> ParsecT String Uniq Identity String -> Parser [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Uniq Identity String
qualifiable)
      [String] -> Parser [String]
forall a. a -> ParsecT String Uniq Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Parser [String]) -> [String] -> Parser [String]
forall a b. (a -> b) -> a -> b
$ ([String] -> Maybe [String] -> [String])
-> Maybe [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe Maybe [String]
ps ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ case [String]
qual of
        -- long is a qualifier as well as a end value itself
        [String
"long"] -> []
        [String]
_ -> [String
"int"]
  Maybe [Type]
args <- Parser [Type] -> ParsecT String Uniq Identity (Maybe [Type])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe Parser [Type]
templateArgs
  case [String] -> Maybe Builtin
maybeBuiltin ((String -> String -> Ordering) -> [String] -> [String]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((String -> String -> Ordering) -> String -> String -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
qual [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
parts) of
    Just Builtin
builtin -> Type -> Parser Type
forall a. a -> ParsecT String Uniq Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Parser Type) -> Type -> Parser Type
forall a b. (a -> b) -> a -> b
$ Builtin -> Type
Builtin Builtin
builtin
    -- TODO: Perhaps verify that 'qual' is empty if not used.
    Maybe Builtin
Nothing -> Name -> Maybe [Type] -> Uniq -> Type
Named (Name -> Maybe [Type] -> Uniq -> Type)
-> Parser Name
-> ParsecT String Uniq Identity (Maybe [Type] -> Uniq -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (case [String]
parts of
      [] -> String -> Parser Name
forall a. HasCallStack => String -> a
error String
"empty identifier"
      [String
part] -> String -> Uniq -> Name
Unqual String
part (Uniq -> Name) -> ParsecT String Uniq Identity Uniq -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Uniq Identity Uniq
genUniq
      [String]
_ -> [String] -> String -> Uniq -> Name
Qual ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
parts) ([String] -> String
forall a. HasCallStack => [a] -> a
last [String]
parts) (Uniq -> Name) -> ParsecT String Uniq Identity Uniq -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Uniq Identity Uniq
genUniq) ParsecT String Uniq Identity (Maybe [Type] -> Uniq -> Type)
-> ParsecT String Uniq Identity (Maybe [Type])
-> ParsecT String Uniq Identity (Uniq -> Type)
forall a b.
ParsecT String Uniq Identity (a -> b)
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [Type] -> ParsecT String Uniq Identity (Maybe [Type])
forall a. a -> ParsecT String Uniq Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Type]
args ParsecT String Uniq Identity (Uniq -> Type)
-> ParsecT String Uniq Identity Uniq -> Parser Type
forall a b.
ParsecT String Uniq Identity (a -> b)
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String Uniq Identity Uniq
genUniq

typeQual :: Parser [String]
typeQual :: Parser [String]
typeQual = ([String] -> [String]) -> Parser [String] -> Parser [String]
forall a b.
(a -> b)
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> String -> Ordering) -> [String] -> [String]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((String -> String -> Ordering) -> [String] -> [String])
-> (String -> String -> Ordering) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> String -> Ordering) -> String -> String -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare)
  (Parser [String] -> Parser [String])
-> ([ParsecT String Uniq Identity String] -> Parser [String])
-> [ParsecT String Uniq Identity String]
-> Parser [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT String Uniq Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String Uniq Identity String -> Parser [String])
-> ([ParsecT String Uniq Identity String]
    -> ParsecT String Uniq Identity String)
-> [ParsecT String Uniq Identity String]
-> Parser [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT String Uniq Identity String]
-> ParsecT String Uniq Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT String Uniq Identity String] -> Parser [String])
-> [ParsecT String Uniq Identity String] -> Parser [String]
forall a b. (a -> b) -> a -> b
$ (String -> ParsecT String Uniq Identity String)
-> [String] -> [ParsecT String Uniq Identity String]
forall a b. (a -> b) -> [a] -> [b]
map String -> ParsecT String Uniq Identity String
word [String
"long", String
"unsigned", String
"signed"]

templateArgs :: Parser [Type]
templateArgs :: Parser [Type]
templateArgs = ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity String
-> Parser [Type]
-> Parser [Type]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> ParsecT String Uniq Identity String
word String
"<") (String -> ParsecT String Uniq Identity String
word String
">") (Parser Type -> Parser [Type]
forall a. Parser a -> Parser [a]
commas Parser Type
type_)

qualifiable :: Parser String
qualifiable :: ParsecT String Uniq Identity String
qualifiable = [ParsecT String Uniq Identity String]
-> ParsecT String Uniq Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT String Uniq Identity String]
 -> ParsecT String Uniq Identity String)
-> [ParsecT String Uniq Identity String]
-> ParsecT String Uniq Identity String
forall a b. (a -> b) -> a -> b
$ (String -> ParsecT String Uniq Identity String)
-> [String] -> [ParsecT String Uniq Identity String]
forall a b. (a -> b) -> [a] -> [b]
map String -> ParsecT String Uniq Identity String
word
  [String
"char", String
"int", String
"__int64", String
"__int128"]

ref :: Parser (Type -> Type)
ref :: ParsecT String Uniq Identity (Type -> Type)
ref = (Type -> Uniq -> Type) -> Uniq -> Type -> Type
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Type -> Uniq -> Type) -> Uniq -> Type -> Type)
-> ParsecT String Uniq Identity (Type -> Uniq -> Type)
-> ParsecT String Uniq Identity (Uniq -> Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Uniq -> Type
Ptr (Type -> Uniq -> Type)
-> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity (Type -> Uniq -> Type)
forall a b.
a
-> ParsecT String Uniq Identity b -> ParsecT String Uniq Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String Uniq Identity String
word String
"*" ParsecT String Uniq Identity (Type -> Uniq -> Type)
-> ParsecT String Uniq Identity (Type -> Uniq -> Type)
-> ParsecT String Uniq Identity (Type -> Uniq -> Type)
forall a.
ParsecT String Uniq Identity a
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Type -> Uniq -> Type
Ref (Type -> Uniq -> Type)
-> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity (Type -> Uniq -> Type)
forall a b.
a
-> ParsecT String Uniq Identity b -> ParsecT String Uniq Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String Uniq Identity String
word String
"&") ParsecT String Uniq Identity (Uniq -> Type -> Type)
-> ParsecT String Uniq Identity Uniq
-> ParsecT String Uniq Identity (Type -> Type)
forall a b.
ParsecT String Uniq Identity (a -> b)
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String Uniq Identity Uniq
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 :: Type -> Type
normalizeParameterType Type
t = case Type -> Type
normalizeType Type
t of
  CV Set CV
_ Type
t' Uniq
_ -> Type
t'
  Type
other -> Type
other

normalizeType :: Type -> Type
normalizeType :: Type -> Type
normalizeType Type
t = case Type
t of
  Builtin{} -> Type
t
  Named Name
name Maybe [Type]
args Uniq
u -> Name -> Maybe [Type] -> Uniq -> Type
Named Name
name ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
normalizeType ([Type] -> [Type]) -> Maybe [Type] -> Maybe [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Type]
args) Uniq
u
  Ptr Type
t' Uniq
u -> Type -> Uniq -> Type
Ptr (Type -> Type
normalizeType Type
t') Uniq
u
  Ref Type
t' Uniq
u -> Type -> Uniq -> Type
Ref (Type -> Type
normalizeType Type
t') Uniq
u
  CV Set CV
cvs Type
t' Uniq
_ | Set CV -> Bool
forall a. Set a -> Bool
Set.null Set CV
cvs -> Type -> Type
normalizeType Type
t'
  CV Set CV
cvs (CV Set CV
cvs' Type
t' Uniq
_) Uniq
u -> Type -> Type
normalizeType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Set CV -> Type -> Uniq -> Type
CV (Set CV
cvs Set CV -> Set CV -> Set CV
forall a. Semigroup a => a -> a -> a
<> Set CV
cvs') Type
t' Uniq
u
  CV Set CV
cvs Type
t' Uniq
u -> Set CV -> Type -> Uniq -> Type
CV Set CV
cvs (Type -> Type
normalizeType Type
t') Uniq
u

--------------------------------------------------------------------------------
-- Names

data Name = Qual [String] String Uniq | Unqual String Uniq
  deriving (Int -> Name -> String -> String
[Name] -> String -> String
Name -> String
(Int -> Name -> String -> String)
-> (Name -> String) -> ([Name] -> String -> String) -> Show Name
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Name -> String -> String
showsPrec :: Int -> Name -> String -> String
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> String -> String
showList :: [Name] -> String -> String
Show)

instance Eq Name where
  Qual [String]
a String
b Uniq
_ == :: Name -> Name -> Bool
== Qual [String]
c String
d Uniq
_ = ([String]
a, String
b) ([String], String) -> ([String], String) -> Bool
forall a. Eq a => a -> a -> Bool
== ([String]
c, String
d)
  Unqual String
a Uniq
_ == Unqual String
b Uniq
_ = String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b
  Name
_ == Name
_ = Bool
False

idParts :: Parser [String]
idParts :: Parser [String]
idParts = do
  ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (String -> ParsecT String Uniq Identity String
word String
"::") -- possible leading "::"
  ParsecT String Uniq Identity String
rawId ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity String -> Parser [String]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` String -> ParsecT String Uniq Identity String
word String
"::"

showName :: Name -> String -> String
showName :: Name -> String -> String
showName (Unqual String
name Uniq
_) String
args = String -> String -> [String] -> String
lengthEncode String
"" String
args [String
name]
showName (Qual [String]
names String
name Uniq
_) String
args = String -> String -> [String] -> String
lengthEncode String
"" String
args ([String]
names [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
name])

lengthEncode :: String -> String -> [String] -> String
lengthEncode :: String -> String -> [String] -> String
lengthEncode String
cvs String
args = \case
  [String
"std", String
"allocator"] -> String
"Sa"
  [String
"std", String
"basic_string"] -> String
"Sb" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
args
  [String
"std", String
"string"] -> String
"Ss"
  [String
"std", String
"istream"] -> String
"Si"
  [String
"std", String
"ostream"] -> String
"So"
  [String
"std", String
"iostream"] -> String
"Sd"
  [String
"std", String
"size_t"] -> String
"m"
  [String
"std", String
name] -> String
"St" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
lengthPrefix String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
args
  String
"std":[String]
names -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"NSt", (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
lengthPrefix [String]
names, String
args, String
"E"]
  [String
name] -> String -> String
lengthPrefix String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
args
  [String]
names -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"N", String
cvs, (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
lengthPrefix [String]
names, String
args, String
"E"]

lengthPrefix :: String -> String
lengthPrefix :: String -> String
lengthPrefix = (String -> String -> String) -> (String, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> String
forall a. [a] -> [a] -> [a]
(++) ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (String -> Int) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> String)
-> (String -> String) -> String -> (String, String)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& String -> String
forall a. a -> a
id)

nestedId :: Parser Name
nestedId :: Parser Name
nestedId = do
  [String]
parts <- Parser [String]
idParts
  (case [String]
parts of
    [String
part] -> String -> Uniq -> Name
Unqual String
part
    [String]
_ -> [String] -> String -> Uniq -> Name
Qual ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
parts) ([String] -> String
forall a. HasCallStack => [a] -> a
last [String]
parts)) (Uniq -> Name) -> ParsecT String Uniq Identity Uniq -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Uniq Identity Uniq
genUniq

rawId :: Parser String
rawId :: ParsecT String Uniq Identity String
rawId = ParsecT String Uniq Identity CV -> ParsecT String Uniq Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT String Uniq Identity CV
cvQual ParsecT String Uniq Identity ()
-> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity String
forall a b.
ParsecT String Uniq Identity a
-> ParsecT String Uniq Identity b -> ParsecT String Uniq Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity String
lexeme
  ((Char -> String -> String)
-> ParsecT String Uniq Identity Char
-> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity String
forall a b c.
(a -> b -> c)
-> ParsecT String Uniq Identity a
-> ParsecT String Uniq Identity b
-> ParsecT String Uniq Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) ParsecT String Uniq Identity Char
nondigit (ParsecT String Uniq Identity Char
-> ParsecT String Uniq Identity String
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String Uniq Identity Char
 -> ParsecT String Uniq Identity String)
-> ParsecT String Uniq Identity Char
-> ParsecT String Uniq Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String Uniq Identity Char
nondigit ParsecT String Uniq Identity Char
-> ParsecT String Uniq Identity Char
-> ParsecT String Uniq Identity Char
forall a.
ParsecT String Uniq Identity a
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String Uniq Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) ParsecT String Uniq Identity String
-> String -> ParsecT String Uniq Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"identifier")

nondigit :: Parser Char
nondigit :: ParsecT String Uniq Identity Char
nondigit = ParsecT String Uniq Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String Uniq Identity Char
-> ParsecT String Uniq Identity Char
-> ParsecT String Uniq Identity Char
forall a.
ParsecT String Uniq Identity a
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT String Uniq Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 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 (Sub -> Sub -> Bool
(Sub -> Sub -> Bool) -> (Sub -> Sub -> Bool) -> Eq Sub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sub -> Sub -> Bool
== :: Sub -> Sub -> Bool
$c/= :: Sub -> Sub -> Bool
/= :: Sub -> Sub -> Bool
Eq, Int -> Sub -> String -> String
[Sub] -> String -> String
Sub -> String
(Int -> Sub -> String -> String)
-> (Sub -> String) -> ([Sub] -> String -> String) -> Show Sub
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Sub -> String -> String
showsPrec :: Int -> Sub -> String -> String
$cshow :: Sub -> String
show :: Sub -> String
$cshowList :: [Sub] -> String -> String
showList :: [Sub] -> String -> String
Show)

subIndex :: (Sub -> Bool) -> Sig -> Maybe Index
subIndex :: (Sub -> Bool) -> Sig -> Maybe Index
subIndex Sub -> Bool
f = (Int -> Index) -> Maybe Int -> Maybe Index
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Index
Index (Maybe Int -> Maybe Index)
-> (Sig -> Maybe Int) -> Sig -> Maybe Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sub -> Bool) -> [Sub] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex Sub -> Bool
f ([Sub] -> Maybe Int) -> (Sig -> [Sub]) -> Sig -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sub -> Sub -> Bool) -> [Sub] -> [Sub]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Sub -> Sub -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Sub -> Sub -> Bool) -> (Sub -> Sub) -> Sub -> Sub -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Sub -> Sub
ignoreUniq) ([Sub] -> [Sub]) -> (Sig -> [Sub]) -> Sig -> [Sub]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> [Sub]
sigSubs
  where
  ignoreUniq :: Sub -> Sub
ignoreUniq (QualSub [String]
names Uniq
_) = [String] -> Uniq -> Sub
QualSub [String]
names (Uniq -> Sub) -> Uniq -> Sub
forall a b. (a -> b) -> a -> b
$ Int -> Uniq
Uniq Int
0
  ignoreUniq (NameSub [String]
names Maybe [Type]
name Uniq
_) = [String] -> Maybe [Type] -> Uniq -> Sub
NameSub [String]
names Maybe [Type]
name (Uniq -> Sub) -> Uniq -> Sub
forall a b. (a -> b) -> a -> b
$ Int -> Uniq
Uniq Int
0
  ignoreUniq Sub
t = Sub
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 -> [Sub]
sigSubs (Sig Unqual{} [Type]
types Set CV
_)
  = (Type -> [Sub]) -> [Type] -> [Sub]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [Sub]
typeSubs [Type]
types
sigSubs (Sig (Qual [String]
names String
_ Uniq
u) [Type]
types Set CV
_)
  =  [[String] -> Uniq -> Sub
QualSub [String]
nss Uniq
u | [String]
nss <- [[String]] -> [[String]]
forall a. HasCallStack => [a] -> [a]
tail ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [String] -> [[String]]
forall a. [a] -> [[a]]
inits [String]
names]
  [Sub] -> [Sub] -> [Sub]
forall a. [a] -> [a] -> [a]
++ (Type -> [Sub]) -> [Type] -> [Sub]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [Sub]
typeSubs [Type]
types

typeSubs :: Type -> [Sub]
typeSubs :: Type -> [Sub]
typeSubs Builtin{} = []
typeSubs (Named (Unqual String
name Uniq
u) Maybe [Type]
args Uniq
_)
  = [String] -> Maybe [Type] -> Uniq -> Sub
NameSub [String
name] Maybe [Type]
forall a. Maybe a
Nothing Uniq
u
  Sub -> [Sub] -> [Sub]
forall a. a -> [a] -> [a]
: [[String] -> Maybe [Type] -> Uniq -> Sub
NameSub [String
name] Maybe [Type]
args Uniq
u | Maybe [Type] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [Type]
args]
typeSubs (Named (Qual [String]
names String
name Uniq
u) Maybe [Type]
args Uniq
_)
  =  [[String] -> Uniq -> Sub
QualSub [String]
nss Uniq
u | [String]
nss <- [[String]] -> [[String]]
forall a. HasCallStack => [a] -> [a]
tail ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [String] -> [[String]]
forall a. [a] -> [[a]]
inits [String]
names]
  [Sub] -> [Sub] -> [Sub]
forall a. [a] -> [a] -> [a]
++ [[String] -> Maybe [Type] -> Uniq -> Sub
NameSub [String]
names' Maybe [Type]
forall a. Maybe a
Nothing Uniq
u]
  [Sub] -> [Sub] -> [Sub]
forall a. [a] -> [a] -> [a]
++ [[String] -> Maybe [Type] -> Uniq -> Sub
NameSub [String]
names' Maybe [Type]
args Uniq
u | Maybe [Type] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [Type]
args]
  where
  names' :: [String]
names' = [String]
names [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
name]
typeSubs t :: Type
t@(Ptr Type
t' Uniq
_) = Type -> [Sub]
typeSubs Type
t' [Sub] -> [Sub] -> [Sub]
forall a. [a] -> [a] -> [a]
++ [Type -> Sub
TypeSub Type
t]
typeSubs t :: Type
t@(Ref Type
t' Uniq
_) = Type -> [Sub]
typeSubs Type
t' [Sub] -> [Sub] -> [Sub]
forall a. [a] -> [a] -> [a]
++ [Type -> Sub
TypeSub Type
t]
typeSubs t :: Type
t@(CV Set CV
_ Type
t' Uniq
_) = Type -> [Sub]
typeSubs Type
t' [Sub] -> [Sub] -> [Sub]
forall a. [a] -> [a] -> [a]
++ [Type -> Sub
TypeSub Type
t]

--------------------------------------------------------------------------------
-- Substitution indices
--
-- Backreferences to substitutions are mangled in base 36.

newtype Index = Index Int
  deriving (Index
Index -> Index -> Bounded Index
forall a. a -> a -> Bounded a
$cminBound :: Index
minBound :: Index
$cmaxBound :: Index
maxBound :: Index
Bounded, Index -> Index -> Bool
(Index -> Index -> Bool) -> (Index -> Index -> Bool) -> Eq Index
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
/= :: Index -> Index -> Bool
Eq, Eq Index
Eq Index =>
(Index -> Index -> Ordering)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Index)
-> (Index -> Index -> Index)
-> Ord Index
Index -> Index -> Bool
Index -> Index -> Ordering
Index -> Index -> Index
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Index -> Index -> Ordering
compare :: Index -> Index -> Ordering
$c< :: Index -> Index -> Bool
< :: Index -> Index -> Bool
$c<= :: Index -> Index -> Bool
<= :: Index -> Index -> Bool
$c> :: Index -> Index -> Bool
> :: Index -> Index -> Bool
$c>= :: Index -> Index -> Bool
>= :: Index -> Index -> Bool
$cmax :: Index -> Index -> Index
max :: Index -> Index -> Index
$cmin :: Index -> Index -> Index
min :: Index -> Index -> Index
Ord)

instance Show Index where
  show :: Index -> String
show (Index Int
0) = String
"S_"
  show (Index Int
n) = String
"S" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> (Int -> Char) -> Int -> String -> String
forall a. Integral a => a -> (Int -> Char) -> a -> String -> String
showIntAtBase Int
36 Int -> Char
forall {a}. Enum a => Int -> a
c (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
"_"
    where
    c :: Int -> a
c Int
x = Int -> a
forall {a}. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
      then Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
      else Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)

--------------------------------------------------------------------------------
-- cv-qualifiers
--
-- cv-qualifiers are ordered and deduplicated, so we store them in sets.

data CV = Volatile | Restrict | Const
  deriving (CV -> CV -> Bool
(CV -> CV -> Bool) -> (CV -> CV -> Bool) -> Eq CV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CV -> CV -> Bool
== :: CV -> CV -> Bool
$c/= :: CV -> CV -> Bool
/= :: CV -> CV -> Bool
Eq, Eq CV
Eq CV =>
(CV -> CV -> Ordering)
-> (CV -> CV -> Bool)
-> (CV -> CV -> Bool)
-> (CV -> CV -> Bool)
-> (CV -> CV -> Bool)
-> (CV -> CV -> CV)
-> (CV -> CV -> CV)
-> Ord CV
CV -> CV -> Bool
CV -> CV -> Ordering
CV -> CV -> CV
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CV -> CV -> Ordering
compare :: CV -> CV -> Ordering
$c< :: CV -> CV -> Bool
< :: CV -> CV -> Bool
$c<= :: CV -> CV -> Bool
<= :: CV -> CV -> Bool
$c> :: CV -> CV -> Bool
> :: CV -> CV -> Bool
$c>= :: CV -> CV -> Bool
>= :: CV -> CV -> Bool
$cmax :: CV -> CV -> CV
max :: CV -> CV -> CV
$cmin :: CV -> CV -> CV
min :: CV -> CV -> CV
Ord)

instance Show CV where
  show :: CV -> String
show = \case
    CV
Const -> String
"K"
    CV
Restrict -> String
"r"
    CV
Volatile -> String
"V"

constQual :: Parser CV
constQual :: ParsecT String Uniq Identity CV
constQual = CV
Const CV
-> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity CV
forall a b.
a
-> ParsecT String Uniq Identity b -> ParsecT String Uniq Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String Uniq Identity String
word String
"const"

cvQuals :: Parser (Set CV)
cvQuals :: Parser (Set CV)
cvQuals = [CV] -> Set CV
forall a. Ord a => [a] -> Set a
Set.fromList ([CV] -> Set CV)
-> ParsecT String Uniq Identity [CV] -> Parser (Set CV)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Uniq Identity CV
-> ParsecT String Uniq Identity [CV]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String Uniq Identity CV
cvQual

cvQual :: Parser CV
cvQual :: ParsecT String Uniq Identity CV
cvQual = [ParsecT String Uniq Identity CV]
-> ParsecT String Uniq Identity CV
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT String Uniq Identity CV
constQual, ParsecT String Uniq Identity CV
volatileQual, ParsecT String Uniq Identity CV
restrictQual]

mkCv :: Set CV -> Type -> Uniq -> Type
mkCv :: Set CV -> Type -> Uniq -> Type
mkCv Set CV
cvs (CV Set CV
cvs' Type
t Uniq
_) Uniq
u = Set CV -> Type -> Uniq -> Type
CV (Set CV
cvs Set CV -> Set CV -> Set CV
forall a. Semigroup a => a -> a -> a
<> Set CV
cvs') Type
t Uniq
u
mkCv Set CV
cvs Type
t Uniq
u = Set CV -> Type -> Uniq -> Type
CV Set CV
cvs Type
t Uniq
u

-- Basically unnecessary.
restrictQual :: Parser CV
restrictQual :: ParsecT String Uniq Identity CV
restrictQual = CV
Restrict CV
-> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity CV
forall a b.
a
-> ParsecT String Uniq Identity b -> ParsecT String Uniq Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String Uniq Identity String
word String
"restrict"

showCvs :: Set CV -> String
showCvs :: Set CV -> String
showCvs = (CV -> String) -> [CV] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CV -> String
forall a. Show a => a -> String
show ([CV] -> String) -> (Set CV -> [CV]) -> Set CV -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set CV -> [CV]
forall a. Set a -> [a]
Set.toList

volatileQual :: Parser CV
volatileQual :: ParsecT String Uniq Identity CV
volatileQual = CV
Volatile CV
-> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity CV
forall a b.
a
-> ParsecT String Uniq Identity b -> ParsecT String Uniq Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String Uniq Identity String
word String
"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 (Int -> Uniq
Uniq -> Int
Uniq -> [Uniq]
Uniq -> Uniq
Uniq -> Uniq -> [Uniq]
Uniq -> Uniq -> Uniq -> [Uniq]
(Uniq -> Uniq)
-> (Uniq -> Uniq)
-> (Int -> Uniq)
-> (Uniq -> Int)
-> (Uniq -> [Uniq])
-> (Uniq -> Uniq -> [Uniq])
-> (Uniq -> Uniq -> [Uniq])
-> (Uniq -> Uniq -> Uniq -> [Uniq])
-> Enum Uniq
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Uniq -> Uniq
succ :: Uniq -> Uniq
$cpred :: Uniq -> Uniq
pred :: Uniq -> Uniq
$ctoEnum :: Int -> Uniq
toEnum :: Int -> Uniq
$cfromEnum :: Uniq -> Int
fromEnum :: Uniq -> Int
$cenumFrom :: Uniq -> [Uniq]
enumFrom :: Uniq -> [Uniq]
$cenumFromThen :: Uniq -> Uniq -> [Uniq]
enumFromThen :: Uniq -> Uniq -> [Uniq]
$cenumFromTo :: Uniq -> Uniq -> [Uniq]
enumFromTo :: Uniq -> Uniq -> [Uniq]
$cenumFromThenTo :: Uniq -> Uniq -> Uniq -> [Uniq]
enumFromThenTo :: Uniq -> Uniq -> Uniq -> [Uniq]
Enum, Uniq -> Uniq -> Bool
(Uniq -> Uniq -> Bool) -> (Uniq -> Uniq -> Bool) -> Eq Uniq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Uniq -> Uniq -> Bool
== :: Uniq -> Uniq -> Bool
$c/= :: Uniq -> Uniq -> Bool
/= :: Uniq -> Uniq -> Bool
Eq, Int -> Uniq -> String -> String
[Uniq] -> String -> String
Uniq -> String
(Int -> Uniq -> String -> String)
-> (Uniq -> String) -> ([Uniq] -> String -> String) -> Show Uniq
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Uniq -> String -> String
showsPrec :: Int -> Uniq -> String -> String
$cshow :: Uniq -> String
show :: Uniq -> String
$cshowList :: [Uniq] -> String -> String
showList :: [Uniq] -> String -> String
Show)

genUniq :: Parser Uniq
genUniq :: ParsecT String Uniq Identity Uniq
genUniq = do
  Uniq
next <- ParsecT String Uniq Identity Uniq
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (Uniq -> Uniq) -> ParsecT String Uniq Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState Uniq -> Uniq
forall a. Enum a => a -> a
succ
  Uniq -> ParsecT String Uniq Identity Uniq
forall a. a -> ParsecT String Uniq Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Uniq
next

typeUniq :: Type -> Maybe Uniq
typeUniq :: Type -> Maybe Uniq
typeUniq Builtin{} = Maybe Uniq
forall a. Maybe a
Nothing
typeUniq (Named Name
_ Maybe [Type]
_ Uniq
u) = Uniq -> Maybe Uniq
forall a. a -> Maybe a
Just Uniq
u
typeUniq (Ptr Type
_ Uniq
u) = Uniq -> Maybe Uniq
forall a. a -> Maybe a
Just Uniq
u
typeUniq (Ref Type
_ Uniq
u) = Uniq -> Maybe Uniq
forall a. a -> Maybe a
Just Uniq
u
typeUniq (CV Set CV
_ Type
_ Uniq
u) = Uniq -> Maybe Uniq
forall a. a -> Maybe a
Just Uniq
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 :: forall a. Parser a -> Parser [a]
commas = (ParsecT String Uniq Identity a
-> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity [a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy` String -> ParsecT String Uniq Identity String
word String
",")

list :: Parser a -> Parser [a]
list :: forall a. Parser a -> Parser [a]
list = Parser [a] -> Parser [a]
forall a. Parser a -> Parser a
paren (Parser [a] -> Parser [a])
-> (Parser a -> Parser [a]) -> Parser a -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
commas

lexeme :: Parser String -> Parser String
lexeme :: ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity String
lexeme = (ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity ()
-> ParsecT String Uniq Identity String
forall a b.
ParsecT String Uniq Identity a
-> ParsecT String Uniq Identity b -> ParsecT String Uniq Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String Uniq Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)

opt :: (Monoid a) => Parser a -> Parser a
opt :: forall a. Monoid a => Parser a -> Parser a
opt = a
-> ParsecT String Uniq Identity a -> ParsecT String Uniq Identity a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
forall a. Monoid a => a
mempty

paren :: Parser a -> Parser a
paren :: forall a. Parser a -> Parser a
paren = ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity a
-> ParsecT String Uniq Identity a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> ParsecT String Uniq Identity String
word String
"(") (String -> ParsecT String Uniq Identity String
word String
")")

word :: String -> Parser String
word :: String -> ParsecT String Uniq Identity String
word = ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String Uniq Identity String
 -> ParsecT String Uniq Identity String)
-> (String -> ParsecT String Uniq Identity String)
-> String
-> ParsecT String Uniq Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT String Uniq Identity String
-> ParsecT String Uniq Identity String
lexeme (ParsecT String Uniq Identity String
 -> ParsecT String Uniq Identity String)
-> (String -> ParsecT String Uniq Identity String)
-> String
-> ParsecT String Uniq Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String Uniq Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
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 (Builtin -> Builtin -> Bool
(Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Bool) -> Eq Builtin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Builtin -> Builtin -> Bool
== :: Builtin -> Builtin -> Bool
$c/= :: Builtin -> Builtin -> Bool
/= :: Builtin -> Builtin -> Bool
Eq)

instance Show Builtin where
  show :: Builtin -> String
show = \case
    Builtin
Void -> String
"v"
    Builtin
WChar -> String
"w"
    Builtin
Bool -> String
"b"
    Builtin
Char -> String
"c"
    Builtin
SChar -> String
"a"
    Builtin
UChar -> String
"h"
    Builtin
Short -> String
"s"
    Builtin
UShort -> String
"t"
    Builtin
Int -> String
"i"
    Builtin
UInt -> String
"j"
    Builtin
Long -> String
"l"
    Builtin
ULong -> String
"m"
    Builtin
LongLong -> String
"x"
    Builtin
ULongLong -> String
"y"
    Builtin
LongLongLong -> String
"n"
    Builtin
ULongLongLong -> String
"o"
    Builtin
Float -> String
"f"
    Builtin
Double -> String
"d"
    Builtin
LongDouble -> String
"e"
    Builtin
LongLongDouble -> String
"g"
    Builtin
Char32 -> String
"Di"
    Builtin
Char16 -> String
"Ds"

maybeBuiltin :: [String] -> Maybe Builtin
maybeBuiltin :: [String] -> Maybe Builtin
maybeBuiltin = \case
  [String
"void"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Void
  [String
"wchar_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
WChar
  [String
"bool"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Bool
  [String
"char"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Char
  -- WTB disjunctive patterns.
  [String
"signed", String
"char"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
SChar
  [String
"int8_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
SChar
  [String
"unsigned", String
"char"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
UChar
  [String
"uint8_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
UChar
  [String
"short"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Short
  [String
"short", String
"int"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Short
  [String
"int16_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Short
  [String
"unsigned", String
"short"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
UShort
  [String
"unsigned", String
"short", String
"int"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
UShort
  [String
"uint16_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
UShort
  [String
"int"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Int
  [String
"int32_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Int
  [String
"unsigned"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
UInt
  [String
"unsigned", String
"int"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
UInt
  [String
"uint32_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
UInt
  [String
"long"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Long
  [String
"int64_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Long
  [String
"unsigned", String
"long"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
ULong
  [String
"unsigned", String
"long", String
"int"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
ULong
  [String
"uint64_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
ULong
  [String
"size_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
ULong
  [String
"long", String
"long"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
LongLong
  [String
"long", String
"long", String
"int"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
LongLong
  [String
"__int64"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
LongLong
  [String
"unsigned", String
"long", String
"long"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
ULongLong
  [String
"unsigned", String
"long", String
"long", String
"int"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
ULongLong
  [String
"unsigned", String
"__int64"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
ULongLong
  [String
"__int128"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
LongLongLong
  [String
"unsigned", String
"__int128"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
ULongLongLong
  [String
"float"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Float
  [String
"double"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Double
  [String
"long", String
"double"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
LongDouble
  [String
"__float80"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
LongDouble
  [String
"__float128"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
LongLongDouble
  [String
"char32_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Char32
  [String
"char16_t"] -> Builtin -> Maybe Builtin
forall a. a -> Maybe a
Just Builtin
Char16
  [String]
_ -> Maybe Builtin
forall a. Maybe a
Nothing