{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
{-# OPTIONS_GHC -Wwarn #-}
module Apigen.Parser.InferClasses (simplify) where

import           Apigen.Parser.SymbolTable  (M, Name, SId, SIdToName, Sym,
                                             display, mustLookupM, renameM)
import           Apigen.Types               (Constness (..), Decl (..))
import           Control.Arrow              (Arrow (first, second))
import           Control.Monad              ((>=>))
import           Control.Monad.Extra        (mapMaybeM)
import qualified Control.Monad.State.Strict as State
import           Data.Bifunctor             (Bifunctor (bimap))
import           Data.HashMap.Strict        (HashMap)
import qualified Data.HashMap.Strict        as HashMap
import           Data.List                  (sortOn)
import qualified Data.List                  as List
import qualified Data.Maybe                 as Maybe
import           Data.Ord                   (Down (Down))
import qualified Data.Text                  as Text
import           Data.Tuple                 (swap)
import           Language.Cimple            (Lexeme (..))

type NameTable = HashMap Name Sym

insertClass :: SId -> Sym -> M NameTable ()
insertClass :: SId -> Sym -> M NameTable ()
insertClass SId
sid Sym
sym = do
    Name
name <- SId -> M NameTable Name
forall s. SId -> M s Name
mustLookupM SId
sid
    ((SIdToName, NameTable) -> (SIdToName, NameTable))
-> M NameTable ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, NameTable) -> (SIdToName, NameTable))
 -> M NameTable ())
-> ((SIdToName, NameTable) -> (SIdToName, NameTable))
-> M NameTable ()
forall a b. (a -> b) -> a -> b
$ (NameTable -> NameTable)
-> (SIdToName, NameTable) -> (SIdToName, NameTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((NameTable -> NameTable)
 -> (SIdToName, NameTable) -> (SIdToName, NameTable))
-> (NameTable -> NameTable)
-> (SIdToName, NameTable)
-> (SIdToName, NameTable)
forall a b. (a -> b) -> a -> b
$ Name -> Sym -> NameTable -> NameTable
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (([Text] -> [Text]) -> Name -> Name
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toLower) Name
name) Sym
sym

prefixes :: Name -> HashMap Name a -> [(Name, a)]
prefixes :: Name -> HashMap Name a -> [(Name, a)]
prefixes Name
name =
    ((Name, a) -> Down SId) -> [(Name, a)] -> [(Name, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (SId -> Down SId
forall a. a -> Down a
Down (SId -> Down SId) -> ((Name, a) -> SId) -> (Name, a) -> Down SId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SId] -> SId
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([SId] -> SId) -> ((Name, a) -> [SId]) -> (Name, a) -> SId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> SId) -> [Text] -> [SId]
forall a b. (a -> b) -> [a] -> [b]
map Text -> SId
Text.length ([Text] -> [SId]) -> ((Name, a) -> [Text]) -> (Name, a) -> [SId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd (Name -> [Text]) -> ((Name, a) -> Name) -> (Name, a) -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, a) -> Name
forall a b. (a, b) -> a
fst)
    ([(Name, a)] -> [(Name, a)])
-> (HashMap Name a -> [(Name, a)]) -> HashMap Name a -> [(Name, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, a) -> Bool) -> [(Name, a)] -> [(Name, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` Name -> [Text]
forall a b. (a, b) -> b
snd Name
name) ([Text] -> Bool) -> ((Name, a) -> [Text]) -> (Name, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd (Name -> [Text]) -> ((Name, a) -> Name) -> (Name, a) -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, a) -> Name
forall a b. (a, b) -> a
fst)
    ([(Name, a)] -> [(Name, a)])
-> (HashMap Name a -> [(Name, a)]) -> HashMap Name a -> [(Name, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Name a -> [(Name, a)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList

matchesThis :: Maybe (Lexeme SId) -> Lexeme SId -> Bool
matchesThis :: Maybe (Lexeme SId) -> Lexeme SId -> Bool
matchesThis Maybe (Lexeme SId)
Nothing Lexeme SId
_                        = Bool
False
matchesThis (Just (L AlexPosn
_ LexemeClass
_ SId
this)) (L AlexPosn
_ LexemeClass
_ SId
name) = SId
this SId -> SId -> Bool
forall a. Eq a => a -> a -> Bool
== SId
name

data MemberType
    = Static
    | Member
    | New
    | Free

insert :: Name -> Lexeme SId -> [Sym] -> (MemberType -> Sym) -> MemberType -> M NameTable ()
insert :: Name
-> Lexeme SId
-> [Sym]
-> (MemberType -> Sym)
-> MemberType
-> M NameTable ()
insert Name
k Lexeme SId
clsName [Sym]
mems MemberType -> Sym
sym =
    ((SIdToName, NameTable) -> (SIdToName, NameTable))
-> M NameTable ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, NameTable) -> (SIdToName, NameTable))
 -> M NameTable ())
-> (MemberType -> (SIdToName, NameTable) -> (SIdToName, NameTable))
-> MemberType
-> M NameTable ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameTable -> NameTable)
-> (SIdToName, NameTable) -> (SIdToName, NameTable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((NameTable -> NameTable)
 -> (SIdToName, NameTable) -> (SIdToName, NameTable))
-> (MemberType -> NameTable -> NameTable)
-> MemberType
-> (SIdToName, NameTable)
-> (SIdToName, NameTable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Sym -> NameTable -> NameTable
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
k (Sym -> NameTable -> NameTable)
-> (MemberType -> Sym) -> MemberType -> NameTable -> NameTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme SId -> [Sym] -> Sym
forall lexeme. lexeme -> [Decl lexeme] -> Decl lexeme
ClassDecl Lexeme SId
clsName ([Sym] -> Sym) -> (MemberType -> [Sym]) -> MemberType -> Sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sym]
mems [Sym] -> [Sym] -> [Sym]
forall a. [a] -> [a] -> [a]
++) ([Sym] -> [Sym]) -> (MemberType -> [Sym]) -> MemberType -> [Sym]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sym -> [Sym] -> [Sym]
forall a. a -> [a] -> [a]
:[]) (Sym -> [Sym]) -> (MemberType -> Sym) -> MemberType -> [Sym]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemberType -> Sym
sym

insertMember :: Maybe (Lexeme SId) -> Lexeme SId -> (MemberType -> Sym) -> M NameTable (Maybe Sym)
insertMember :: Maybe (Lexeme SId)
-> Lexeme SId -> (MemberType -> Sym) -> M NameTable (Maybe Sym)
insertMember Maybe (Lexeme SId)
this (L AlexPosn
_ LexemeClass
_ SId
sid) MemberType -> Sym
sym = do
    NameTable
syms <- (SIdToName, NameTable) -> NameTable
forall a b. (a, b) -> b
snd ((SIdToName, NameTable) -> NameTable)
-> StateT (SIdToName, NameTable) Identity (SIdToName, NameTable)
-> StateT (SIdToName, NameTable) Identity NameTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (SIdToName, NameTable) Identity (SIdToName, NameTable)
forall s (m :: * -> *). MonadState s m => m s
State.get
    Name
name <- SId -> M NameTable Name
forall s. SId -> M s Name
mustLookupM SId
sid
    let errPrefix :: [Text]
errPrefix = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
Maybe.fromMaybe [] (Maybe [Text] -> [Text])
-> ([[Text]] -> Maybe [Text]) -> [[Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Bool) -> [[Text]] -> Maybe [Text]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ([Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` Name -> [Text]
forall a b. (a, b) -> b
snd Name
name) ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [[Text
"Err"], [Text
"err"]]
    case Name -> NameTable -> [(Name, Sym)]
forall a. Name -> HashMap Name a -> [(Name, a)]
prefixes (([Text] -> [Text]) -> Name -> Name
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toLower ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SId -> [Text] -> [Text]
forall a. SId -> [a] -> [a]
drop ([Text] -> SId
forall (t :: * -> *) a. Foldable t => t a -> SId
length [Text]
errPrefix)) Name
name) NameTable
syms of
        (Name
k, ClassDecl Lexeme SId
clsName [Sym]
mems):[(Name, Sym)]
_ -> do
            -- No need to check for commonality here. The prefixes function already did.
            -- Put back the Err/err prefix if we had one.
            let renamed :: Name
renamed = ([Text] -> [Text]) -> ([Text] -> [Text]) -> Name -> Name
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toLower (Name -> [Text]
forall a b. (a, b) -> b
snd Name
k)) (([Text]
errPrefix [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SId -> [Text] -> [Text]
forall a. SId -> [a] -> [a]
drop ([Text] -> SId
forall (t :: * -> *) a. Foldable t => t a -> SId
length [Text]
errPrefix SId -> SId -> SId
forall a. Num a => a -> a -> a
+ [Text] -> SId
forall (t :: * -> *) a. Foldable t => t a -> SId
length (Name -> [Text]
forall a b. (a, b) -> b
snd Name
k))) Name
name
            (Name -> Name) -> SId -> M NameTable ()
forall s. (Name -> Name) -> SId -> M s ()
renameM (Name -> Name -> Name
forall a b. a -> b -> a
const Name
renamed) SId
sid
            Name
-> Lexeme SId
-> [Sym]
-> (MemberType -> Sym)
-> MemberType
-> M NameTable ()
insert Name
k Lexeme SId
clsName [Sym]
mems MemberType -> Sym
sym (MemberType -> M NameTable ()) -> MemberType -> M NameTable ()
forall a b. (a -> b) -> a -> b
$ case Name -> [Text]
forall a b. (a, b) -> b
snd Name
renamed of
                -- TODO(iphydf): Check return type.
                [Text
"new"]  -> MemberType
New
                [Text
"derive"]  -> MemberType
New
                [Text
"derive",Text
"with",Text
"salt"]  -> MemberType
New
                -- TODO(iphydf): Check first param type.
                [Text
"free"] -> MemberType
Free
                [Text
"kill"] -> MemberType
Free
                [Text]
_ | Maybe (Lexeme SId) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (Lexeme SId)
this -> MemberType
Static
                [Text]
_ | Maybe (Lexeme SId) -> Lexeme SId -> Bool
matchesThis Maybe (Lexeme SId)
this Lexeme SId
clsName -> MemberType
Member
                [Text]
_ ->
                    [Char] -> MemberType
forall a. HasCallStack => [Char] -> a
error ([Char] -> MemberType) -> [Char] -> MemberType
forall a b. (a -> b) -> a -> b
$ Maybe (Lexeme SId) -> [Char]
forall a. Show a => a -> [Char]
show Maybe (Lexeme SId)
this [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" `this` is not the correct namespace for " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Name -> [Char]
display Name
k [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" renamed " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Name -> [Char]
display Name
renamed
            Maybe Sym -> M NameTable (Maybe Sym)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Sym
forall a. Maybe a
Nothing
        (Name
k, Sym
_):[(Name, Sym)]
_ -> do
            Name
sname <- SId -> M NameTable Name
forall s. SId -> M s Name
mustLookupM SId
sid
            [Char] -> M NameTable (Maybe Sym)
forall a. HasCallStack => [Char] -> a
error ([Char] -> M NameTable (Maybe Sym))
-> [Char] -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ [Char]
"cannot insert " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Name -> [Char]
display Name
sname [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" into " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Name -> [Char]
display Name
k
        [] -> Maybe Sym -> M NameTable (Maybe Sym)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Sym -> M NameTable (Maybe Sym))
-> Maybe Sym -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ Sym -> Maybe Sym
forall a. a -> Maybe a
Just (Sym -> Maybe Sym) -> Sym -> Maybe Sym
forall a b. (a -> b) -> a -> b
$ MemberType -> Sym
sym MemberType
Static

insertMethod :: Sym -> Lexeme SId -> Maybe (Lexeme SId) -> [Sym] -> Constness -> M NameTable (Maybe Sym)
insertMethod :: Sym
-> Lexeme SId
-> Maybe (Lexeme SId)
-> [Sym]
-> Constness
-> M NameTable (Maybe Sym)
insertMethod Sym
ret Lexeme SId
name Maybe (Lexeme SId)
this [Sym]
params Constness
constness =
    Maybe (Lexeme SId)
-> Lexeme SId -> (MemberType -> Sym) -> M NameTable (Maybe Sym)
insertMember Maybe (Lexeme SId)
this Lexeme SId
name ((MemberType -> Sym) -> M NameTable (Maybe Sym))
-> (MemberType -> Sym) -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ \case
        MemberType
New    -> Lexeme SId -> [Sym] -> Sym
forall lexeme. lexeme -> [Decl lexeme] -> Decl lexeme
Constructor Lexeme SId
name [Sym]
params
        MemberType
Free   -> Lexeme SId -> [Sym] -> Sym
forall lexeme. lexeme -> [Decl lexeme] -> Decl lexeme
Destructor Lexeme SId
name ([Sym] -> [Sym]
forall a. [a] -> [a]
tail [Sym]
params)
        MemberType
Member -> Constness -> Sym -> Lexeme SId -> [Sym] -> Sym
forall lexeme.
Constness -> Decl lexeme -> lexeme -> [Decl lexeme] -> Decl lexeme
Method Constness
constness Sym
ret Lexeme SId
name ([Sym] -> [Sym]
forall a. [a] -> [a]
tail [Sym]
params)
        MemberType
Static -> Sym -> Lexeme SId -> [Sym] -> Sym
forall lexeme.
Decl lexeme -> lexeme -> [Decl lexeme] -> Decl lexeme
Function Sym
ret Lexeme SId
name [Sym]
params

inject :: [Sym] -> M NameTable [Sym]
inject :: [Sym] -> M NameTable [Sym]
inject [Sym]
xs = ([Sym]
xs [Sym] -> [Sym] -> [Sym]
forall a. [a] -> [a] -> [a]
++) ([Sym] -> [Sym])
-> ((SIdToName, NameTable) -> [Sym])
-> (SIdToName, NameTable)
-> [Sym]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameTable -> [Sym]
forall k v. HashMap k v -> [v]
HashMap.elems (NameTable -> [Sym])
-> ((SIdToName, NameTable) -> NameTable)
-> (SIdToName, NameTable)
-> [Sym]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SIdToName, NameTable) -> NameTable
forall a b. (a, b) -> b
snd ((SIdToName, NameTable) -> [Sym])
-> StateT (SIdToName, NameTable) Identity (SIdToName, NameTable)
-> M NameTable [Sym]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (SIdToName, NameTable) Identity (SIdToName, NameTable)
forall s (m :: * -> *). MonadState s m => m s
State.get

simplify :: SIdToName -> [Sym] -> (SIdToName, [Sym])
simplify :: SIdToName -> [Sym] -> (SIdToName, [Sym])
simplify SIdToName
st = ((SIdToName, NameTable) -> SIdToName)
-> ((SIdToName, NameTable), [Sym]) -> (SIdToName, [Sym])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (SIdToName, NameTable) -> SIdToName
forall a b. (a, b) -> a
fst (((SIdToName, NameTable), [Sym]) -> (SIdToName, [Sym]))
-> ([Sym] -> ((SIdToName, NameTable), [Sym]))
-> [Sym]
-> (SIdToName, [Sym])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sym], (SIdToName, NameTable)) -> ((SIdToName, NameTable), [Sym])
forall a b. (a, b) -> (b, a)
swap (([Sym], (SIdToName, NameTable))
 -> ((SIdToName, NameTable), [Sym]))
-> ([Sym] -> ([Sym], (SIdToName, NameTable)))
-> [Sym]
-> ((SIdToName, NameTable), [Sym])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (M NameTable [Sym]
 -> (SIdToName, NameTable) -> ([Sym], (SIdToName, NameTable)))
-> (SIdToName, NameTable)
-> M NameTable [Sym]
-> ([Sym], (SIdToName, NameTable))
forall a b c. (a -> b -> c) -> b -> a -> c
flip M NameTable [Sym]
-> (SIdToName, NameTable) -> ([Sym], (SIdToName, NameTable))
forall s a. State s a -> s -> (a, s)
State.runState (SIdToName
st, NameTable
forall k v. HashMap k v
HashMap.empty) (M NameTable [Sym] -> ([Sym], (SIdToName, NameTable)))
-> ([Sym] -> M NameTable [Sym])
-> [Sym]
-> ([Sym], (SIdToName, NameTable))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Sym -> M NameTable (Maybe Sym)) -> [Sym] -> M NameTable [Sym]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Sym -> M NameTable (Maybe Sym)
createClasses ([Sym] -> M NameTable [Sym])
-> ([Sym] -> M NameTable [Sym]) -> [Sym] -> M NameTable [Sym]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Sym -> M NameTable (Maybe Sym)) -> [Sym] -> M NameTable [Sym]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Sym -> M NameTable (Maybe Sym)
go)
  where
    createClasses :: Sym -> M NameTable (Maybe Sym)
    createClasses :: Sym -> M NameTable (Maybe Sym)
createClasses (Namespace [Text]
ns [Sym]
mems) =
        Sym -> Maybe Sym
forall a. a -> Maybe a
Just (Sym -> Maybe Sym) -> ([Sym] -> Sym) -> [Sym] -> Maybe Sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Sym] -> Sym
forall lexeme. [Text] -> [Decl lexeme] -> Decl lexeme
Namespace [Text]
ns ([Sym] -> Maybe Sym)
-> M NameTable [Sym] -> M NameTable (Maybe Sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sym -> M NameTable (Maybe Sym)) -> [Sym] -> M NameTable [Sym]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Sym -> M NameTable (Maybe Sym)
createClasses [Sym]
mems
    createClasses (TypeDecl l :: Lexeme SId
l@(L AlexPosn
_ LexemeClass
_ SId
name)) = do
        SId -> Sym -> M NameTable ()
insertClass SId
name (Lexeme SId -> [Sym] -> Sym
forall lexeme. lexeme -> [Decl lexeme] -> Decl lexeme
ClassDecl Lexeme SId
l [])
        Maybe Sym -> M NameTable (Maybe Sym)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Sym
forall a. Maybe a
Nothing
    createClasses Sym
x = Maybe Sym -> M NameTable (Maybe Sym)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Sym -> M NameTable (Maybe Sym))
-> Maybe Sym -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ Sym -> Maybe Sym
forall a. a -> Maybe a
Just Sym
x

    go :: Sym -> M NameTable (Maybe Sym)
    go :: Sym -> M NameTable (Maybe Sym)
go (Namespace [Text]
ns [Sym]
mems) =
        Sym -> Maybe Sym
forall a. a -> Maybe a
Just (Sym -> Maybe Sym) -> ([Sym] -> Sym) -> [Sym] -> Maybe Sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Sym] -> Sym
forall lexeme. [Text] -> [Decl lexeme] -> Decl lexeme
Namespace [Text]
ns ([Sym] -> Maybe Sym)
-> M NameTable [Sym] -> M NameTable (Maybe Sym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Sym -> M NameTable (Maybe Sym)) -> [Sym] -> M NameTable [Sym]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Sym -> M NameTable (Maybe Sym)
go [Sym]
mems M NameTable [Sym]
-> ([Sym] -> M NameTable [Sym]) -> M NameTable [Sym]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Sym] -> M NameTable [Sym]
inject)

    go (Function Sym
ret Lexeme SId
name params :: [Sym]
params@(Var (PointerType Lexeme SId
this) Lexeme SId
_:[Sym]
_)) = do
        Sym
-> Lexeme SId
-> Maybe (Lexeme SId)
-> [Sym]
-> Constness
-> M NameTable (Maybe Sym)
insertMethod Sym
ret Lexeme SId
name (Lexeme SId -> Maybe (Lexeme SId)
forall a. a -> Maybe a
Just Lexeme SId
this) [Sym]
params Constness
MutableThis
    go (Function Sym
ret Lexeme SId
name params :: [Sym]
params@(Var (ConstPointerType Lexeme SId
this) Lexeme SId
_:[Sym]
_)) = do
        Sym
-> Lexeme SId
-> Maybe (Lexeme SId)
-> [Sym]
-> Constness
-> M NameTable (Maybe Sym)
insertMethod Sym
ret Lexeme SId
name (Lexeme SId -> Maybe (Lexeme SId)
forall a. a -> Maybe a
Just Lexeme SId
this) [Sym]
params Constness
ConstThis
    go (Function ret :: Sym
ret@PointerType{} Lexeme SId
name [Sym]
params) = do
        Sym
-> Lexeme SId
-> Maybe (Lexeme SId)
-> [Sym]
-> Constness
-> M NameTable (Maybe Sym)
insertMethod Sym
ret Lexeme SId
name Maybe (Lexeme SId)
forall a. Maybe a
Nothing [Sym]
params Constness
MutableThis
    go decl :: Sym
decl@(Function Sym
_ Lexeme SId
name [Sym]
_) = do
        Maybe (Lexeme SId)
-> Lexeme SId -> (MemberType -> Sym) -> M NameTable (Maybe Sym)
insertMember Maybe (Lexeme SId)
forall a. Maybe a
Nothing Lexeme SId
name ((MemberType -> Sym) -> M NameTable (Maybe Sym))
-> (MemberType -> Sym) -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ Sym -> MemberType -> Sym
forall a b. a -> b -> a
const Sym
decl
    go decl :: Sym
decl@(Enumeration [Generated]
_ Lexeme SId
name [Sym]
_) = do
        Maybe (Lexeme SId)
-> Lexeme SId -> (MemberType -> Sym) -> M NameTable (Maybe Sym)
insertMember Maybe (Lexeme SId)
forall a. Maybe a
Nothing Lexeme SId
name ((MemberType -> Sym) -> M NameTable (Maybe Sym))
-> (MemberType -> Sym) -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ Sym -> MemberType -> Sym
forall a b. a -> b -> a
const Sym
decl
    go decl :: Sym
decl@(CallbackTypeDecl Lexeme SId
name [Sym]
_) = do
        Maybe (Lexeme SId)
-> Lexeme SId -> (MemberType -> Sym) -> M NameTable (Maybe Sym)
insertMember Maybe (Lexeme SId)
forall a. Maybe a
Nothing Lexeme SId
name ((MemberType -> Sym) -> M NameTable (Maybe Sym))
-> (MemberType -> Sym) -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ Sym -> MemberType -> Sym
forall a b. a -> b -> a
const Sym
decl
    go decl :: Sym
decl@(IdTypeDecl Lexeme SId
name) = do
        Maybe (Lexeme SId)
-> Lexeme SId -> (MemberType -> Sym) -> M NameTable (Maybe Sym)
insertMember Maybe (Lexeme SId)
forall a. Maybe a
Nothing Lexeme SId
name ((MemberType -> Sym) -> M NameTable (Maybe Sym))
-> (MemberType -> Sym) -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ Sym -> MemberType -> Sym
forall a b. a -> b -> a
const Sym
decl
    go decl :: Sym
decl@(Define Lexeme SId
name) = do
        Maybe (Lexeme SId)
-> Lexeme SId -> (MemberType -> Sym) -> M NameTable (Maybe Sym)
insertMember Maybe (Lexeme SId)
forall a. Maybe a
Nothing Lexeme SId
name ((MemberType -> Sym) -> M NameTable (Maybe Sym))
-> (MemberType -> Sym) -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ Sym -> MemberType -> Sym
forall a b. a -> b -> a
const Sym
decl
    go Sym
x = [Char] -> M NameTable (Maybe Sym)
forall a. HasCallStack => [Char] -> a
error ([Char] -> M NameTable (Maybe Sym))
-> [Char] -> M NameTable (Maybe Sym)
forall a b. (a -> b) -> a -> b
$ [Char]
"unhandled in InferClasses: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Sym -> [Char]
forall a. Show a => a -> [Char]
show Sym
x