{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
-- | Finds the declared types of variables and fields.
module Tokstyle.Cimple.Analysis.Types
    ( Structs
    , structs
    , structName
    , callbackType
    , typeIn
    , bare
    ) where

import           Data.Fix                           (Fix (..))
import           Data.Map.Strict                    (Map)
import qualified Data.Map.Strict                    as Map
import           Data.Maybe                         (listToMaybe)
import           Data.Text                          (Text)
import           Language.Cimple                    (Lexeme (..), NodeF (..))
import qualified Language.Cimple                    as C
import           Tokstyle.Cimple.Analysis.Functions (Function (..), bare,
                                                     universe)


callbackType :: C.Node (Lexeme Text) -> Maybe Text
callbackType :: Node (Lexeme Text) -> Maybe Text
callbackType Node (Lexeme Text)
ty = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [ Text
name | Fix (TyFunc (L AlexPosn
_ LexemeClass
_ Text
name)) <- Node (Lexeme Text) -> [Node (Lexeme Text)]
universe Node (Lexeme Text)
ty ]

-- | The declared type of each field of each struct.
type Structs = Map Text (Map Text (C.Node (Lexeme Text)))

structs :: [(FilePath, [C.Node (Lexeme Text)])] -> Structs
structs :: [(FilePath, [Node (Lexeme Text)])] -> Structs
structs [(FilePath, [Node (Lexeme Text)])]
tus = [(Text, Map Text (Node (Lexeme Text)))] -> Structs
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (Text
name, [(Text, Node (Lexeme Text))] -> Map Text (Node (Lexeme Text))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Text
f, Node (Lexeme Text)
ty) | Fix (MemberDecl (Fix (VarDecl Node (Lexeme Text)
ty (L AlexPosn
_ LexemeClass
_ Text
f) [Node (Lexeme Text)]
_)) Maybe (Lexeme Text)
_) <- [Node (Lexeme Text)]
members ])
    | (FilePath
_, [Node (Lexeme Text)]
nodes) <- [(FilePath, [Node (Lexeme Text)])]
tus, Node (Lexeme Text)
node <- [Node (Lexeme Text)]
nodes, Fix NodeF (Lexeme Text) (Node (Lexeme Text))
n <- Node (Lexeme Text) -> [Node (Lexeme Text)]
universe Node (Lexeme Text)
node
    , (Text
name, [Node (Lexeme Text)]
members) <- case NodeF (Lexeme Text) (Node (Lexeme Text))
n of
        Struct (L AlexPosn
_ LexemeClass
_ Text
s) [Node (Lexeme Text)]
ms                     -> [(Text
s, [Node (Lexeme Text)]
ms)]
        Typedef (Fix (Struct Lexeme Text
_ [Node (Lexeme Text)]
ms)) (L AlexPosn
_ LexemeClass
_ Text
s) [Node (Lexeme Text)]
_ -> [(Text
s, [Node (Lexeme Text)]
ms)]
        NodeF (Lexeme Text) (Node (Lexeme Text))
_                                       -> []
    ]

-- | Looks through pointers and `const`, so `const Foo *` gives `Foo`.
structName :: C.Node (Lexeme Text) -> Maybe Text
structName :: Node (Lexeme Text) -> Maybe Text
structName Node (Lexeme Text)
ty = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe
    [ Text
n | Fix NodeF (Lexeme Text) (Node (Lexeme Text))
t <- Node (Lexeme Text) -> [Node (Lexeme Text)]
universe Node (Lexeme Text)
ty, Just Text
n <- [case NodeF (Lexeme Text) (Node (Lexeme Text))
t of
            TyStruct (L AlexPosn
_ LexemeClass
_ Text
n')      -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n'
            TyUserDefined (L AlexPosn
_ LexemeClass
_ Text
n') -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n'
            NodeF (Lexeme Text) (Node (Lexeme Text))
_                        -> Maybe Text
forall a. Maybe a
Nothing] ]

-- | The declared type of an expression in a function, where it names a
-- variable or a field.
typeIn :: Structs -> Function -> C.Node (Lexeme Text) -> Maybe (C.Node (Lexeme Text))
typeIn :: Structs
-> Function -> Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
typeIn Structs
types Function
fn = Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
typeOf
  where
    locals :: Map Text (Node (Lexeme Text))
locals = [(Text, Node (Lexeme Text))] -> Map Text (Node (Lexeme Text))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Text
v, Node (Lexeme Text)
ty) | Fix (VarDecl Node (Lexeme Text)
ty (L AlexPosn
_ LexemeClass
_ Text
v) [Node (Lexeme Text)]
_) <- Node (Lexeme Text) -> [Node (Lexeme Text)]
universe (Function -> Node (Lexeme Text)
fnDefn Function
fn) ]
    typeOf :: Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
typeOf Node (Lexeme Text)
e = case Node (Lexeme Text) -> Node (Lexeme Text)
bare Node (Lexeme Text)
e of
        Fix (VarExpr (L AlexPosn
_ LexemeClass
_ Text
v))         -> Text -> Map Text (Node (Lexeme Text)) -> Maybe (Node (Lexeme Text))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
v Map Text (Node (Lexeme Text))
locals
        Fix (PointerAccess Node (Lexeme Text)
x (L AlexPosn
_ LexemeClass
_ Text
f)) -> Node (Lexeme Text) -> Text -> Maybe (Node (Lexeme Text))
field Node (Lexeme Text)
x Text
f
        Fix (MemberAccess Node (Lexeme Text)
x (L AlexPosn
_ LexemeClass
_ Text
f))  -> Node (Lexeme Text) -> Text -> Maybe (Node (Lexeme Text))
field Node (Lexeme Text)
x Text
f
        -- `T a[N]` is declared with type `T`, so `a[i]` has the type of `a`.
        Fix (ArrayAccess Node (Lexeme Text)
x Node (Lexeme Text)
_)           -> Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
typeOf Node (Lexeme Text)
x
        Node (Lexeme Text)
_                               -> Maybe (Node (Lexeme Text))
forall a. Maybe a
Nothing
    field :: Node (Lexeme Text) -> Text -> Maybe (Node (Lexeme Text))
field Node (Lexeme Text)
x Text
f = Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
typeOf Node (Lexeme Text)
x Maybe (Node (Lexeme Text))
-> (Node (Lexeme Text) -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node (Lexeme Text) -> Maybe Text
structName Maybe Text
-> (Text -> Maybe (Map Text (Node (Lexeme Text))))
-> Maybe (Map Text (Node (Lexeme Text)))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Structs -> Maybe (Map Text (Node (Lexeme Text)))
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Structs
types) Maybe (Map Text (Node (Lexeme Text)))
-> (Map Text (Node (Lexeme Text)) -> Maybe (Node (Lexeme Text)))
-> Maybe (Node (Lexeme Text))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Map Text (Node (Lexeme Text)) -> Maybe (Node (Lexeme Text))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
f