{-# LANGUAGE OverloadedStrings #-} module Tokstyle.Cimple.Analysis.FuncScopes (analyse) where import Control.Monad (foldM, when) import qualified Control.Monad.State.Lazy as State import Data.Text (Text) import qualified Data.Text as Text import Language.Cimple (Lexeme (..), Node (..), Scope (..), lexemeLine, lexemeText) import Language.Cimple.Diagnostics (warn) analyse :: (FilePath, [Node a (Lexeme Text)]) -> [Text] analyse :: (FilePath, [Node a (Lexeme Text)]) -> [Text] analyse (FilePath file, [Node a (Lexeme Text)] ast) = [Text] -> [Text] forall a. [a] -> [a] reverse ([Text] -> [Text]) -> [Text] -> [Text] forall a b. (a -> b) -> a -> b $ ([(Text, (Lexeme Text, Scope))], [Text]) -> [Text] forall a b. (a, b) -> b snd (([(Text, (Lexeme Text, Scope))], [Text]) -> [Text]) -> ([(Text, (Lexeme Text, Scope))], [Text]) -> [Text] forall a b. (a -> b) -> a -> b $ State [Text] [(Text, (Lexeme Text, Scope))] -> [Text] -> ([(Text, (Lexeme Text, Scope))], [Text]) forall s a. State s a -> s -> (a, s) State.runState (([(Text, (Lexeme Text, Scope))] -> Node a (Lexeme Text) -> State [Text] [(Text, (Lexeme Text, Scope))]) -> [(Text, (Lexeme Text, Scope))] -> [Node a (Lexeme Text)] -> State [Text] [(Text, (Lexeme Text, Scope))] forall (t :: * -> *) (m :: * -> *) b a. (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b foldM [(Text, (Lexeme Text, Scope))] -> Node a (Lexeme Text) -> State [Text] [(Text, (Lexeme Text, Scope))] forall diags attr. HasDiagnostics diags => [(Text, (Lexeme Text, Scope))] -> Node attr (Lexeme Text) -> StateT diags Identity [(Text, (Lexeme Text, Scope))] go [] [Node a (Lexeme Text)] ast) [] where go :: [(Text, (Lexeme Text, Scope))] -> Node attr (Lexeme Text) -> StateT diags Identity [(Text, (Lexeme Text, Scope))] go [(Text, (Lexeme Text, Scope))] decls (FunctionDecl Scope declScope (FunctionPrototype Node attr (Lexeme Text) _ Lexeme Text name [Node attr (Lexeme Text)] _) Maybe (Node attr (Lexeme Text)) _) = [(Text, (Lexeme Text, Scope))] -> StateT diags Identity [(Text, (Lexeme Text, Scope))] forall (m :: * -> *) a. Monad m => a -> m a return ([(Text, (Lexeme Text, Scope))] -> StateT diags Identity [(Text, (Lexeme Text, Scope))]) -> [(Text, (Lexeme Text, Scope))] -> StateT diags Identity [(Text, (Lexeme Text, Scope))] forall a b. (a -> b) -> a -> b $ (Lexeme Text -> Text forall text. Lexeme text -> text lexemeText Lexeme Text name, (Lexeme Text name, Scope declScope)) (Text, (Lexeme Text, Scope)) -> [(Text, (Lexeme Text, Scope))] -> [(Text, (Lexeme Text, Scope))] forall a. a -> [a] -> [a] : [(Text, (Lexeme Text, Scope))] decls go [(Text, (Lexeme Text, Scope))] decls (FunctionDefn Scope defnScope (FunctionPrototype Node attr (Lexeme Text) _ Lexeme Text name [Node attr (Lexeme Text)] _) [Node attr (Lexeme Text)] _) = case Text -> [(Text, (Lexeme Text, Scope))] -> Maybe (Lexeme Text, Scope) forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup (Lexeme Text -> Text forall text. Lexeme text -> text lexemeText Lexeme Text name) [(Text, (Lexeme Text, Scope))] decls of Maybe (Lexeme Text, Scope) Nothing -> [(Text, (Lexeme Text, Scope))] -> StateT diags Identity [(Text, (Lexeme Text, Scope))] forall (m :: * -> *) a. Monad m => a -> m a return [(Text, (Lexeme Text, Scope))] decls Just (Lexeme Text decl, Scope declScope) -> do Bool -> StateT diags Identity () -> StateT diags Identity () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Scope declScope Scope -> Scope -> Bool forall a. Eq a => a -> a -> Bool /= Scope defnScope) (StateT diags Identity () -> StateT diags Identity ()) -> StateT diags Identity () -> StateT diags Identity () forall a b. (a -> b) -> a -> b $ FilePath -> Lexeme Text -> Text -> StateT diags Identity () forall diags. HasDiagnostics diags => FilePath -> Lexeme Text -> Text -> DiagnosticsT diags () warn FilePath file Lexeme Text name (Text -> StateT diags Identity ()) -> Text -> StateT diags Identity () forall a b. (a -> b) -> a -> b $ Lexeme Text -> Scope -> Scope -> Text warning Lexeme Text decl Scope declScope Scope defnScope [(Text, (Lexeme Text, Scope))] -> StateT diags Identity [(Text, (Lexeme Text, Scope))] forall (m :: * -> *) a. Monad m => a -> m a return [(Text, (Lexeme Text, Scope))] decls go [(Text, (Lexeme Text, Scope))] decls Node attr (Lexeme Text) _ = [(Text, (Lexeme Text, Scope))] -> StateT diags Identity [(Text, (Lexeme Text, Scope))] forall (m :: * -> *) a. Monad m => a -> m a return [(Text, (Lexeme Text, Scope))] decls warning :: Lexeme Text -> Scope -> Scope -> Text warning Lexeme Text decl Scope declScope Scope defnScope = Text "function definition `" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Lexeme Text -> Text forall text. Lexeme text -> text lexemeText Lexeme Text decl Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "' does not agree with its declaration about scope: " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "declaration on line " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> FilePath -> Text Text.pack (Int -> FilePath forall a. Show a => a -> FilePath show (Lexeme Text -> Int forall text. Lexeme text -> Int lexemeLine Lexeme Text decl)) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " is " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Scope -> Text forall p. IsString p => Scope -> p scopeKeyword Scope declScope Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " but definition is " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Scope -> Text forall p. IsString p => Scope -> p scopeKeyword Scope defnScope scopeKeyword :: Scope -> p scopeKeyword Scope Global = p "extern" scopeKeyword Scope Static = p "static"