{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}
{-# OPTIONS_GHC -Wwarn #-}
module Apigen.Parser.SymbolNumbers where

import           Apigen.Parser.SymbolTable  (NameToSId, SIdToName)
import           Apigen.Patterns
import           Control.Arrow              (Arrow (second))
import           Control.Monad.State.Strict (State)
import qualified Control.Monad.State.Strict as State
import           Data.Fix                   (Fix (..))
import qualified Data.HashMap.Strict        as HashMap
import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import           Data.Tuple                 (swap)
import           GHC.Stack                  (HasCallStack)
import           Language.Cimple            (Lexeme, Node, NodeF (..))
import           Language.Cimple.MapAst     (AstActions (..), astActions,
                                             mapAst, mapFileAst)

type TranslationUnit text = (FilePath, [Node (Lexeme text)])

builtins :: NameToSId
builtins :: NameToSId
builtins = [(([Text], [Text]), Int)] -> NameToSId
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
    [ (([], [Text
"APIGEN",Text
"IGNORE"]), Int
SYM_APIGEN_IGNORE)
    , (([], [Text
"void"      ]), Int
TY_void    )
    , (([], [Text
"char"      ]), Int
TY_char    )
    , (([], [Text
"bool"      ]), Int
TY_bool    )
    , (([], [Text
"int8",Text
"t"  ]), Int
TY_int8_t  )
    , (([], [Text
"uint8",Text
"t" ]), Int
TY_uint8_t )
    , (([], [Text
"int16",Text
"t" ]), Int
TY_int16_t )
    , (([], [Text
"uint16",Text
"t"]), Int
TY_uint16_t)
    , (([], [Text
"int32",Text
"t" ]), Int
TY_int32_t )
    , (([], [Text
"uint32",Text
"t"]), Int
TY_uint32_t)
    , (([], [Text
"int64",Text
"t" ]), Int
TY_int64_t )
    , (([], [Text
"uint64",Text
"t"]), Int
TY_uint64_t)
    , (([], [Text
"size",Text
"t"  ]), Int
TY_size_t  )
    , (([], [Text
"abs"       ]), Int
SYM_abs    )
    , (([], [Text
"max"       ]), Int
SYM_max    )
    ]

symtabActions :: HasCallStack => AstActions (State NameToSId) Text Int
symtabActions :: AstActions (State NameToSId) Text Int
symtabActions = ((Text -> StateT NameToSId Identity Int)
-> AstActions (State NameToSId) Text Int
forall (f :: * -> *) itext otext.
Applicative f =>
(itext -> f otext) -> AstActions f itext otext
astActions HasCallStack => Text -> StateT NameToSId Identity Int
Text -> StateT NameToSId Identity Int
lookupSym)
    { doNode :: FilePath
-> Node (Lexeme Text)
-> State NameToSId (Node (Lexeme Int))
-> State NameToSId (Node (Lexeme Int))
doNode = \FilePath
file Node (Lexeme Text)
node State NameToSId (Node (Lexeme Int))
act -> case Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme Text)
node of
        LicenseDecl{}        -> Node (Lexeme Int) -> State NameToSId (Node (Lexeme Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Node (Lexeme Int) -> State NameToSId (Node (Lexeme Int)))
-> Node (Lexeme Int) -> State NameToSId (Node (Lexeme Int))
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme Int) (Node (Lexeme Int)) -> Node (Lexeme Int)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix NodeF (Lexeme Int) (Node (Lexeme Int))
forall lexeme a. NodeF lexeme a
Ellipsis
        Comment{}            -> Node (Lexeme Int) -> State NameToSId (Node (Lexeme Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Node (Lexeme Int) -> State NameToSId (Node (Lexeme Int)))
-> Node (Lexeme Int) -> State NameToSId (Node (Lexeme Int))
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme Int) (Node (Lexeme Int)) -> Node (Lexeme Int)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix NodeF (Lexeme Int) (Node (Lexeme Int))
forall lexeme a. NodeF lexeme a
Ellipsis
        Commented Node (Lexeme Text)
_ Node (Lexeme Text)
e        -> AstActions (State NameToSId) Text Int
-> FilePath
-> Node (Lexeme Text)
-> State NameToSId (Mapped Text Int (Node (Lexeme Text)))
forall itext otext a (f :: * -> *).
(MapAst itext otext a, Applicative f, HasCallStack) =>
AstActions f itext otext
-> FilePath -> a -> f (Mapped itext otext a)
mapFileAst AstActions (State NameToSId) Text Int
HasCallStack => AstActions (State NameToSId) Text Int
symtabActions FilePath
file Node (Lexeme Text)
e
        CommentSection Node (Lexeme Text)
_ [Node (Lexeme Text)]
e Node (Lexeme Text)
_ -> NodeF (Lexeme Int) (Node (Lexeme Int)) -> Node (Lexeme Int)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NodeF (Lexeme Int) (Node (Lexeme Int)) -> Node (Lexeme Int))
-> ([Node (Lexeme Int)] -> NodeF (Lexeme Int) (Node (Lexeme Int)))
-> [Node (Lexeme Int)]
-> Node (Lexeme Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node (Lexeme Int)] -> NodeF (Lexeme Int) (Node (Lexeme Int))
forall lexeme a. [a] -> NodeF lexeme a
Group ([Node (Lexeme Int)] -> Node (Lexeme Int))
-> State NameToSId [Node (Lexeme Int)]
-> State NameToSId (Node (Lexeme Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstActions (State NameToSId) Text Int
-> FilePath
-> [Node (Lexeme Text)]
-> State NameToSId (Mapped Text Int [Node (Lexeme Text)])
forall itext otext a (f :: * -> *).
(MapAst itext otext a, Applicative f, HasCallStack) =>
AstActions f itext otext
-> FilePath -> a -> f (Mapped itext otext a)
mapFileAst AstActions (State NameToSId) Text Int
HasCallStack => AstActions (State NameToSId) Text Int
symtabActions FilePath
file [Node (Lexeme Text)]
e

        NodeF (Lexeme Text) (Node (Lexeme Text))
_                    -> State NameToSId (Node (Lexeme Int))
act
    }

lookupSym :: HasCallStack => Text -> State NameToSId Int
lookupSym :: Text -> StateT NameToSId Identity Int
lookupSym Text
nameText = do
    NameToSId
syms <- StateT NameToSId Identity NameToSId
forall s (m :: * -> *). MonadState s m => m s
State.get
    let name :: ([a], [Text])
name = ([], Text -> Text -> [Text]
Text.splitOn Text
"_" Text
nameText)
    case ([Text], [Text]) -> NameToSId -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ([Text], [Text])
forall a. ([a], [Text])
name NameToSId
syms of
        Just Int
sym -> Int -> StateT NameToSId Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
sym
        Maybe Int
Nothing -> do
            let num :: Int
num = NameToSId -> Int
forall k v. HashMap k v -> Int
HashMap.size NameToSId
syms
            (NameToSId -> NameToSId) -> StateT NameToSId Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((NameToSId -> NameToSId) -> StateT NameToSId Identity ())
-> (NameToSId -> NameToSId) -> StateT NameToSId Identity ()
forall a b. (a -> b) -> a -> b
$ ([Text], [Text]) -> Int -> NameToSId -> NameToSId
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert ([Text], [Text])
forall a. ([a], [Text])
name Int
num
            Int -> StateT NameToSId Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
num

collect :: HasCallStack => [TranslationUnit Text] -> ([TranslationUnit Int], (SIdToName, ()))
collect :: [TranslationUnit Text] -> ([TranslationUnit Int], (SIdToName, ()))
collect = (NameToSId -> (SIdToName, ()))
-> ([TranslationUnit Int], NameToSId)
-> ([TranslationUnit Int], (SIdToName, ()))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((,()) (SIdToName -> (SIdToName, ()))
-> (NameToSId -> SIdToName) -> NameToSId -> (SIdToName, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameToSId -> SIdToName
invert) (([TranslationUnit Int], NameToSId)
 -> ([TranslationUnit Int], (SIdToName, ())))
-> ([TranslationUnit Text] -> ([TranslationUnit Int], NameToSId))
-> [TranslationUnit Text]
-> ([TranslationUnit Int], (SIdToName, ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State NameToSId [TranslationUnit Int]
 -> NameToSId -> ([TranslationUnit Int], NameToSId))
-> NameToSId
-> State NameToSId [TranslationUnit Int]
-> ([TranslationUnit Int], NameToSId)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State NameToSId [TranslationUnit Int]
-> NameToSId -> ([TranslationUnit Int], NameToSId)
forall s a. State s a -> s -> (a, s)
State.runState NameToSId
builtins (State NameToSId [TranslationUnit Int]
 -> ([TranslationUnit Int], NameToSId))
-> ([TranslationUnit Text]
    -> State NameToSId [TranslationUnit Int])
-> [TranslationUnit Text]
-> ([TranslationUnit Int], NameToSId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstActions (State NameToSId) Text Int
-> [TranslationUnit Text]
-> State NameToSId (Mapped Text Int [TranslationUnit Text])
forall itext otext a (f :: * -> *).
(MapAst itext otext a, Applicative f, HasCallStack) =>
AstActions f itext otext -> a -> f (Mapped itext otext a)
mapAst AstActions (State NameToSId) Text Int
HasCallStack => AstActions (State NameToSId) Text Int
symtabActions

invert :: NameToSId -> SIdToName
invert :: NameToSId -> SIdToName
invert = [(Int, ([Text], [Text]))] -> SIdToName
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Int, ([Text], [Text]))] -> SIdToName)
-> (NameToSId -> [(Int, ([Text], [Text]))])
-> NameToSId
-> SIdToName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((([Text], [Text]), Int) -> (Int, ([Text], [Text])))
-> [(([Text], [Text]), Int)] -> [(Int, ([Text], [Text]))]
forall a b. (a -> b) -> [a] -> [b]
map (([Text], [Text]), Int) -> (Int, ([Text], [Text]))
forall a b. (a, b) -> (b, a)
swap ([(([Text], [Text]), Int)] -> [(Int, ([Text], [Text]))])
-> (NameToSId -> [(([Text], [Text]), Int)])
-> NameToSId
-> [(Int, ([Text], [Text]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameToSId -> [(([Text], [Text]), Int)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList