{-# OPTIONS_GHC -Wwarn -fmax-pmcheck-models=100 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
module Apigen.Parser (parseModel) where
import qualified Apigen.Parser.InferClasses as InferClasses
import qualified Apigen.Parser.InferGenerated as InferGenerated
import qualified Apigen.Parser.InferNamespace as InferNamespace
import qualified Apigen.Parser.InferProperties as InferProperties
import qualified Apigen.Parser.InferSections as InferSections
import qualified Apigen.Parser.InferSizedGet as InferSizedGet
import qualified Apigen.Parser.InferSizedParam as InferSizedParam
import qualified Apigen.Parser.SymbolNumbers as SymbolNumbers
import Apigen.Parser.SymbolTable (M, Name, SId, SIdToName, Sym,
display, mustLookupM, renameM,
resolveM)
import Apigen.Patterns
import Apigen.Types (BitSize (..), BuiltinType (..),
Decl (..), Model (..),
Module (..))
import Control.Arrow (Arrow (first, second))
import Control.Monad ((>=>))
import Control.Monad.Extra (concatMapM)
import Control.Monad.State.Strict (State)
import qualified Control.Monad.State.Strict as State
import Data.Fix (foldFixM)
import Data.Text (Text)
import qualified Data.Text as Text
import Language.Cimple (BinaryOp (..), Lexeme (..),
LexemeClass (..),
LiteralType (ConstId, Int),
Node, NodeF (..), Scope (..),
lexemeText)
parseModel :: [SymbolNumbers.TranslationUnit Text] -> Model (Lexeme Name)
parseModel :: [TranslationUnit Text] -> Model (Lexeme Name)
parseModel = [Module (Lexeme Name)] -> Model (Lexeme Name)
forall lexeme. [Module lexeme] -> Model lexeme
Model ([Module (Lexeme Name)] -> Model (Lexeme Name))
-> ([TranslationUnit Text] -> [Module (Lexeme Name)])
-> [TranslationUnit Text]
-> Model (Lexeme Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(FilePath, [Node (Lexeme SId)])]
-> (SIdToName, ()) -> [Module (Lexeme Name)])
-> ([(FilePath, [Node (Lexeme SId)])], (SIdToName, ()))
-> [Module (Lexeme Name)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [(FilePath, [Node (Lexeme SId)])]
-> (SIdToName, ()) -> [Module (Lexeme Name)]
forall (t :: * -> *) a.
Traversable t =>
t (FilePath, [Node (Lexeme SId)])
-> (SIdToName, a) -> t (Module (Lexeme Name))
mods (([(FilePath, [Node (Lexeme SId)])], (SIdToName, ()))
-> [Module (Lexeme Name)])
-> ([TranslationUnit Text]
-> ([(FilePath, [Node (Lexeme SId)])], (SIdToName, ())))
-> [TranslationUnit Text]
-> [Module (Lexeme Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack =>
[TranslationUnit Text]
-> ([(FilePath, [Node (Lexeme SId)])], (SIdToName, ()))
[TranslationUnit Text]
-> ([(FilePath, [Node (Lexeme SId)])], (SIdToName, ()))
SymbolNumbers.collect
where
mods :: t (FilePath, [Node (Lexeme SId)])
-> (SIdToName, a) -> t (Module (Lexeme Name))
mods t (FilePath, [Node (Lexeme SId)])
tus = State (SIdToName, a) (t (Module (Lexeme Name)))
-> (SIdToName, a) -> t (Module (Lexeme Name))
forall s a. State s a -> s -> a
State.evalState (State (SIdToName, a) (t (Module (Lexeme Name)))
-> (SIdToName, a) -> t (Module (Lexeme Name)))
-> State (SIdToName, a) (t (Module (Lexeme Name)))
-> (SIdToName, a)
-> t (Module (Lexeme Name))
forall a b. (a -> b) -> a -> b
$ ((FilePath, [Node (Lexeme SId)])
-> StateT (SIdToName, a) Identity (Module (Lexeme SId)))
-> t (FilePath, [Node (Lexeme SId)])
-> StateT (SIdToName, a) Identity (t (Module (Lexeme SId)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((FilePath
-> [Node (Lexeme SId)]
-> StateT (SIdToName, a) Identity (Module (Lexeme SId)))
-> (FilePath, [Node (Lexeme SId)])
-> StateT (SIdToName, a) Identity (Module (Lexeme SId))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath
-> [Node (Lexeme SId)]
-> StateT (SIdToName, a) Identity (Module (Lexeme SId))
forall a.
FilePath -> [Node (Lexeme SId)] -> M a (Module (Lexeme SId))
parseModule) t (FilePath, [Node (Lexeme SId)])
tus StateT (SIdToName, a) Identity (t (Module (Lexeme SId)))
-> (t (Module (Lexeme SId))
-> State (SIdToName, a) (t (Module (Lexeme Name))))
-> State (SIdToName, a) (t (Module (Lexeme Name)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Module (Lexeme SId)
-> StateT (SIdToName, a) Identity (Module (Lexeme Name)))
-> t (Module (Lexeme SId))
-> State (SIdToName, a) (t (Module (Lexeme Name)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Module (Lexeme SId)
-> StateT (SIdToName, a) Identity (Module (Lexeme Name))
forall (t :: * -> *) s.
Traversable t =>
t (Lexeme SId) -> State (SIdToName, s) (t (Lexeme Name))
resolveM
parseModule :: FilePath -> [Node (Lexeme SId)] -> M a (Module (Lexeme SId))
parseModule :: FilePath -> [Node (Lexeme SId)] -> M a (Module (Lexeme SId))
parseModule FilePath
f = ([Decl (Lexeme SId)] -> Module (Lexeme SId))
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)]
-> M a (Module (Lexeme SId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> [Decl (Lexeme SId)] -> Module (Lexeme SId)
forall lexeme. FilePath -> [Decl lexeme] -> Module lexeme
Module FilePath
f) (StateT (SIdToName, a) Identity [Decl (Lexeme SId)]
-> M a (Module (Lexeme SId)))
-> ([Node (Lexeme SId)]
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)])
-> [Node (Lexeme SId)]
-> M a (Module (Lexeme SId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Node (Lexeme SId)
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)])
-> [Node (Lexeme SId)]
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((NodeF (Lexeme SId) [Decl (Lexeme SId)]
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)])
-> Node (Lexeme SId)
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)]
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
(t a -> m a) -> Fix t -> m a
foldFixM NodeF (Lexeme SId) [Decl (Lexeme SId)]
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)]
forall a.
NodeF (Lexeme SId) [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
go) ([Node (Lexeme SId)]
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)])
-> ([Decl (Lexeme SId)]
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)])
-> [Node (Lexeme SId)]
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Decl (Lexeme SId)]
-> StateT (SIdToName, a) Identity [Decl (Lexeme SId)]
forall a.
[Decl (Lexeme SId)] -> State (SIdToName, a) [Decl (Lexeme SId)]
runSimplify)
runSimplify :: [Sym] -> State (SIdToName, a) [Sym]
runSimplify :: [Decl (Lexeme SId)] -> State (SIdToName, a) [Decl (Lexeme SId)]
runSimplify [Decl (Lexeme SId)]
decls = do
(SIdToName
st, [Decl (Lexeme SId)]
simplified) <- (SIdToName, [Decl (Lexeme SId)])
-> (SIdToName, [Decl (Lexeme SId)])
simplify ((SIdToName, [Decl (Lexeme SId)])
-> (SIdToName, [Decl (Lexeme SId)]))
-> ((SIdToName, a) -> (SIdToName, [Decl (Lexeme SId)]))
-> (SIdToName, a)
-> (SIdToName, [Decl (Lexeme SId)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Decl (Lexeme SId)])
-> (SIdToName, a) -> (SIdToName, [Decl (Lexeme SId)])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([Decl (Lexeme SId)] -> a -> [Decl (Lexeme SId)]
forall a b. a -> b -> a
const [Decl (Lexeme SId)]
decls) ((SIdToName, a) -> (SIdToName, [Decl (Lexeme SId)]))
-> StateT (SIdToName, a) Identity (SIdToName, a)
-> StateT (SIdToName, a) Identity (SIdToName, [Decl (Lexeme SId)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (SIdToName, a) Identity (SIdToName, a)
forall s (m :: * -> *). MonadState s m => m s
State.get
((SIdToName, a) -> (SIdToName, a))
-> StateT (SIdToName, a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((SIdToName, a) -> (SIdToName, a))
-> StateT (SIdToName, a) Identity ())
-> ((SIdToName, a) -> (SIdToName, a))
-> StateT (SIdToName, a) Identity ()
forall a b. (a -> b) -> a -> b
$ (SIdToName -> SIdToName) -> (SIdToName, a) -> (SIdToName, a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((SIdToName -> SIdToName) -> (SIdToName, a) -> (SIdToName, a))
-> (SIdToName -> SIdToName) -> (SIdToName, a) -> (SIdToName, a)
forall a b. (a -> b) -> a -> b
$ SIdToName -> SIdToName -> SIdToName
forall a b. a -> b -> a
const SIdToName
st
[Decl (Lexeme SId)] -> State (SIdToName, a) [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId)]
simplified
where
simplify :: (SIdToName, [Decl (Lexeme SId)])
-> (SIdToName, [Decl (Lexeme SId)])
simplify = ((SIdToName, [Decl (Lexeme SId)])
-> [SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])]
-> (SIdToName, [Decl (Lexeme SId)]))
-> [SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])]
-> (SIdToName, [Decl (Lexeme SId)])
-> (SIdToName, [Decl (Lexeme SId)])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)]))
-> (SIdToName, [Decl (Lexeme SId)])
-> (SIdToName, [Decl (Lexeme SId)]))
-> (SIdToName, [Decl (Lexeme SId)])
-> [SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])]
-> (SIdToName, [Decl (Lexeme SId)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)]))
-> (SIdToName, [Decl (Lexeme SId)])
-> (SIdToName, [Decl (Lexeme SId)])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry)
[ (,)
, SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])
InferGenerated.simplify
, SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])
InferProperties.simplify
, SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])
InferSizedGet.simplify
, SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])
InferSections.simplify
, SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])
InferClasses.simplify
, SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])
InferSizedParam.simplify
, SIdToName
-> [Decl (Lexeme SId)] -> (SIdToName, [Decl (Lexeme SId)])
InferNamespace.simplify
]
go :: NodeF (Lexeme SId) [Sym] -> M a [Sym]
go :: NodeF (Lexeme SId) [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
go (PreprocInclude (L AlexPosn
_ LexemeClass
LitSysInclude SId
_)) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go (TyPointer [ConstType (BuiltinType UInt{}) ]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go (VarDecl [] Lexeme SId
_ []) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go (FunctionPrototype [] Lexeme SId
_ [[Decl (Lexeme SId)]]
_) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go (PreprocIfndef (L AlexPosn
_ LexemeClass
_ SId
SYM_APIGEN_IGNORE) [[Decl (Lexeme SId)]]
_ [Decl (Lexeme SId)]
es) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId)]
es
go (FunctionPrototype [Decl (Lexeme SId)
ret] Lexeme SId
name [[BuiltinType BuiltinType
Void]]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId)
-> Lexeme SId -> [Decl (Lexeme SId)] -> Decl (Lexeme SId)
forall lexeme.
Decl lexeme -> lexeme -> [Decl lexeme] -> Decl lexeme
Function Decl (Lexeme SId)
ret Lexeme SId
name []]
go (FunctionPrototype [Decl (Lexeme SId)
ret] Lexeme SId
name [[Decl (Lexeme SId)]]
params ) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId)
-> Lexeme SId -> [Decl (Lexeme SId)] -> Decl (Lexeme SId)
forall lexeme.
Decl lexeme -> lexeme -> [Decl lexeme] -> Decl lexeme
Function Decl (Lexeme SId)
ret Lexeme SId
name ([[Decl (Lexeme SId)]] -> [Decl (Lexeme SId)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Decl (Lexeme SId)]]
params)]
go (FunctionDecl Scope
Global [Decl (Lexeme SId)]
func) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId)]
func
go (TypedefFunction [Function (BuiltinType BuiltinType
Void) Lexeme SId
name [Decl (Lexeme SId)]
params]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> [Decl (Lexeme SId)] -> Decl (Lexeme SId)
forall lexeme. lexeme -> [Decl lexeme] -> Decl lexeme
CallbackTypeDecl Lexeme SId
name [Decl (Lexeme SId)]
params]
go (Typedef [BuiltinType (UInt BitSize
B32)] Lexeme SId
name ) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
IdTypeDecl Lexeme SId
name]
go (Enumerator Lexeme SId
name Maybe [Decl (Lexeme SId)]
_) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
EnumMember Lexeme SId
name]
go (EnumConsts (Just Lexeme SId
name) [[Decl (Lexeme SId)]]
enums ) = Lexeme SId -> [[Decl (Lexeme SId)]] -> M a [Decl (Lexeme SId)]
forall a.
Lexeme SId
-> [[Decl (Lexeme SId)]]
-> State (SIdToName, a) [Decl (Lexeme SId)]
mkEnum Lexeme SId
name [[Decl (Lexeme SId)]]
enums
go (EnumDecl Lexeme SId
name [[Decl (Lexeme SId)]]
enums Lexeme SId
_) = Lexeme SId -> [[Decl (Lexeme SId)]] -> M a [Decl (Lexeme SId)]
forall a.
Lexeme SId
-> [[Decl (Lexeme SId)]]
-> State (SIdToName, a) [Decl (Lexeme SId)]
mkEnum Lexeme SId
name [[Decl (Lexeme SId)]]
enums
go (TyPointer [ConstType (BuiltinType BuiltinType
Char)]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType BuiltinType
String]
go (TyPointer [ Typename Lexeme SId
ty ]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
PointerType Lexeme SId
ty]
go (TyPointer [ConstType (Typename Lexeme SId
ty )]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
ConstPointerType Lexeme SId
ty]
go (DeclSpecArray (Just [Decl (Lexeme SId)
expr])) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
SizedArrayType (BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType BuiltinType
Void) Decl (Lexeme SId)
expr]
go (DeclSpecArray Maybe [Decl (Lexeme SId)]
Nothing) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
ArrayType BuiltinType
Void]
go (VarDecl [ BuiltinType BuiltinType
ty ] Lexeme SId
name [[ArrayType BuiltinType
Void]]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Lexeme SId -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> lexeme -> Decl lexeme
Var (BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
ArrayType BuiltinType
ty ) Lexeme SId
name]
go (VarDecl [ConstType (BuiltinType BuiltinType
ty)] Lexeme SId
name [[ArrayType BuiltinType
Void]]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Lexeme SId -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> lexeme -> Decl lexeme
Var (BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
ConstArrayType BuiltinType
ty ) Lexeme SId
name]
go (VarDecl [Typename Lexeme SId
ty ] Lexeme SId
name [[ArrayType BuiltinType
Void]]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Lexeme SId -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> lexeme -> Decl lexeme
Var (Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
UserArrayType Lexeme SId
ty ) Lexeme SId
name]
go (VarDecl [Decl (Lexeme SId)
ty] Lexeme SId
name [[SizedArrayType (BuiltinType BuiltinType
Void) Decl (Lexeme SId)
size]]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Lexeme SId -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> lexeme -> Decl lexeme
Var (Decl (Lexeme SId) -> Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
SizedArrayType Decl (Lexeme SId)
ty Decl (Lexeme SId)
size) Lexeme SId
name]
go (FunctionCall [Ref (L AlexPosn
_ LexemeClass
_ SId
SYM_abs)] [[Decl (Lexeme SId)
expr] ]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme
Abs Decl (Lexeme SId)
expr]
go (FunctionCall [Ref (L AlexPosn
_ LexemeClass
_ SId
SYM_max)] [[Decl (Lexeme SId)
a], [Decl (Lexeme SId)
b]]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
Max Decl (Lexeme SId)
a Decl (Lexeme SId)
b]
go (TyConst [Decl (Lexeme SId)
ty]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme
ConstType Decl (Lexeme SId)
ty]
go (TyPointer [BuiltinType BuiltinType
Void]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType BuiltinType
VoidPtr]
go (TyPointer ty :: [Decl (Lexeme SId)]
ty@[CallbackType{}]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId)]
ty
go (AggregateDecl ty :: [Decl (Lexeme SId)]
ty@[TypeDecl Lexeme SId
_]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId)]
ty
go (Struct Lexeme SId
ty [[Decl (Lexeme SId)]]
_) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
TypeDecl Lexeme SId
ty]
go (TyStruct Lexeme SId
ty) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
Typename Lexeme SId
ty]
go (TyUserDefined Lexeme SId
ty) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
Typename Lexeme SId
ty]
go (TyFunc Lexeme SId
ty) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
CallbackType Lexeme SId
ty]
go (Typedef [Typename Lexeme SId
ty] Lexeme SId
_) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
TypeDecl Lexeme SId
ty]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_void )) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType BuiltinType
Void]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_char )) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType BuiltinType
Char]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_bool )) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType BuiltinType
Bool]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_int8_t )) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType (BitSize -> BuiltinType
SInt BitSize
B8)]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_uint8_t )) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType (BitSize -> BuiltinType
UInt BitSize
B8)]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_int16_t )) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType (BitSize -> BuiltinType
SInt BitSize
B16)]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_uint16_t)) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType (BitSize -> BuiltinType
UInt BitSize
B16)]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_int32_t )) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType (BitSize -> BuiltinType
SInt BitSize
B32)]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_uint32_t)) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType (BitSize -> BuiltinType
UInt BitSize
B32)]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_int64_t )) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType (BitSize -> BuiltinType
SInt BitSize
B64)]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_uint64_t)) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType (BitSize -> BuiltinType
UInt BitSize
B64)]
go (TyStd (L AlexPosn
_ LexemeClass
_ SId
TY_size_t )) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuiltinType -> Decl (Lexeme SId)
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType BuiltinType
SizeT]
go (PreprocDefineConst Lexeme SId
name [Decl (Lexeme SId)]
_) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
Define Lexeme SId
name]
go (VarDecl [Decl (Lexeme SId)
ty] Lexeme SId
name []) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Lexeme SId -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> lexeme -> Decl lexeme
Var Decl (Lexeme SId)
ty Lexeme SId
name]
go (VarExpr Lexeme SId
name) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
Ref Lexeme SId
name]
go (ParenExpr [Decl (Lexeme SId)
x]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme
Paren Decl (Lexeme SId)
x]
go (LiteralExpr LiteralType
ConstId Lexeme SId
name) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
Ref Lexeme SId
name]
go (LiteralExpr LiteralType
Int Lexeme SId
val) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexeme SId -> Decl (Lexeme SId)
forall lexeme. lexeme -> Decl lexeme
IntVal Lexeme SId
val]
go (BinaryExpr [Decl (Lexeme SId)
l] BinaryOp
BopPlus [Decl (Lexeme SId)
r]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
Add Decl (Lexeme SId)
l Decl (Lexeme SId)
r]
go (BinaryExpr [Decl (Lexeme SId)
l] BinaryOp
BopMinus [Decl (Lexeme SId)
r]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
Sub Decl (Lexeme SId)
l Decl (Lexeme SId)
r]
go (BinaryExpr [Decl (Lexeme SId)
l] BinaryOp
BopMul [Decl (Lexeme SId)
r]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
Mul Decl (Lexeme SId)
l Decl (Lexeme SId)
r]
go (BinaryExpr [Decl (Lexeme SId)
l] BinaryOp
BopDiv [Decl (Lexeme SId)
r]) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId) -> Decl (Lexeme SId) -> Decl (Lexeme SId)
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
Div Decl (Lexeme SId)
l Decl (Lexeme SId)
r]
go BinaryExpr{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go CopyrightDecl{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go LicenseDecl{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go Comment{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go CommentSectionEnd{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go CommentInfo{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go PreprocDefine{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go SizeofType{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go MemberDecl{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go MacroBodyFunCall{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go PreprocDefineMacro{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go ParenExpr{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go FunctionCall{} = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go (PreprocIfndef Lexeme SId
_ [[Decl (Lexeme SId)]]
ts [Decl (Lexeme SId)]
es) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)])
-> [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ [[Decl (Lexeme SId)]] -> [Decl (Lexeme SId)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Decl (Lexeme SId)]]
ts [Decl (Lexeme SId)] -> [Decl (Lexeme SId)] -> [Decl (Lexeme SId)]
forall a. [a] -> [a] -> [a]
++ [Decl (Lexeme SId)]
es
go (PreprocElse [[Decl (Lexeme SId)]]
xs) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)])
-> [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ [[Decl (Lexeme SId)]] -> [Decl (Lexeme SId)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Decl (Lexeme SId)]]
xs
go (Group [[Decl (Lexeme SId)]]
xs) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)])
-> [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ [[Decl (Lexeme SId)]] -> [Decl (Lexeme SId)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Decl (Lexeme SId)]]
xs
go (Commented [Decl (Lexeme SId)]
_ [Decl (Lexeme SId)]
x) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId)]
x
go (CommentSection [Decl (Lexeme SId)]
_ [[Decl (Lexeme SId)]]
xs [Decl (Lexeme SId)]
_) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)])
-> [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ [[Decl (Lexeme SId)]] -> [Decl (Lexeme SId)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Decl (Lexeme SId)]]
xs
go (ExternC [[Decl (Lexeme SId)]]
xs) = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)])
-> [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ [[Decl (Lexeme SId)]] -> [Decl (Lexeme SId)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Decl (Lexeme SId)]]
xs
go NodeF (Lexeme SId) [Decl (Lexeme SId)]
Ellipsis = [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go NodeF (Lexeme SId) [Decl (Lexeme SId)]
x = FilePath -> M a [Decl (Lexeme SId)]
forall a. HasCallStack => FilePath -> a
error (FilePath -> M a [Decl (Lexeme SId)])
-> FilePath -> M a [Decl (Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme SId) [Decl (Lexeme SId)] -> FilePath
forall a. Show a => a -> FilePath
show NodeF (Lexeme SId) [Decl (Lexeme SId)]
x
mkEnum :: Lexeme SId -> [[Sym]] -> State (SIdToName, a) [Sym]
mkEnum :: Lexeme SId
-> [[Decl (Lexeme SId)]]
-> State (SIdToName, a) [Decl (Lexeme SId)]
mkEnum Lexeme SId
name [[Decl (Lexeme SId)]]
enums = (Decl (Lexeme SId) -> [Decl (Lexeme SId)] -> [Decl (Lexeme SId)]
forall a. a -> [a] -> [a]
:[]) (Decl (Lexeme SId) -> [Decl (Lexeme SId)])
-> ([Decl (Lexeme SId)] -> Decl (Lexeme SId))
-> [Decl (Lexeme SId)]
-> [Decl (Lexeme SId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Generated]
-> Lexeme SId -> [Decl (Lexeme SId)] -> Decl (Lexeme SId)
forall lexeme.
[Generated] -> lexeme -> [Decl lexeme] -> Decl lexeme
Enumeration [] Lexeme SId
name ([Decl (Lexeme SId)] -> [Decl (Lexeme SId)])
-> State (SIdToName, a) [Decl (Lexeme SId)]
-> State (SIdToName, a) [Decl (Lexeme SId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((SId
-> [Decl (Lexeme SId)] -> State (SIdToName, a) [Decl (Lexeme SId)]
forall a. SId -> [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
stripNamespace (SId
-> [Decl (Lexeme SId)] -> State (SIdToName, a) [Decl (Lexeme SId)])
-> (Lexeme SId -> SId)
-> Lexeme SId
-> [Decl (Lexeme SId)]
-> State (SIdToName, a) [Decl (Lexeme SId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme SId -> SId
forall text. Lexeme text -> text
lexemeText (Lexeme SId
-> [Decl (Lexeme SId)] -> State (SIdToName, a) [Decl (Lexeme SId)])
-> Lexeme SId
-> [Decl (Lexeme SId)]
-> State (SIdToName, a) [Decl (Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ Lexeme SId
name) ([Decl (Lexeme SId)] -> State (SIdToName, a) [Decl (Lexeme SId)])
-> ([[Decl (Lexeme SId)]] -> [Decl (Lexeme SId)])
-> [[Decl (Lexeme SId)]]
-> State (SIdToName, a) [Decl (Lexeme SId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Decl (Lexeme SId)]] -> [Decl (Lexeme SId)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Decl (Lexeme SId)]] -> State (SIdToName, a) [Decl (Lexeme SId)])
-> [[Decl (Lexeme SId)]]
-> State (SIdToName, a) [Decl (Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ [[Decl (Lexeme SId)]]
enums)
stripNamespace :: SId -> [Sym] -> M a [Sym]
stripNamespace :: SId -> [Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
stripNamespace SId
ns [Decl (Lexeme SId)]
decls = do
Name
as <- SId -> M a Name
forall s. SId -> M s Name
mustLookupM SId
ns
((Decl (Lexeme SId) -> StateT (SIdToName, a) Identity ())
-> [Decl (Lexeme SId)] -> StateT (SIdToName, a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Decl (Lexeme SId) -> StateT (SIdToName, a) Identity ())
-> [Decl (Lexeme SId)] -> StateT (SIdToName, a) Identity ())
-> ((SId -> StateT (SIdToName, a) Identity ())
-> Decl (Lexeme SId) -> StateT (SIdToName, a) Identity ())
-> (SId -> StateT (SIdToName, a) Identity ())
-> [Decl (Lexeme SId)]
-> StateT (SIdToName, a) Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lexeme SId -> StateT (SIdToName, a) Identity ())
-> Decl (Lexeme SId) -> StateT (SIdToName, a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Lexeme SId -> StateT (SIdToName, a) Identity ())
-> Decl (Lexeme SId) -> StateT (SIdToName, a) Identity ())
-> ((SId -> StateT (SIdToName, a) Identity ())
-> Lexeme SId -> StateT (SIdToName, a) Identity ())
-> (SId -> StateT (SIdToName, a) Identity ())
-> Decl (Lexeme SId)
-> StateT (SIdToName, a) Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SId -> StateT (SIdToName, a) Identity ())
-> Lexeme SId -> StateT (SIdToName, a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_) ((Name -> Name) -> SId -> StateT (SIdToName, a) Identity ()
forall s. (Name -> Name) -> SId -> M s ()
renameM (Name -> Name -> Name
dropCommon Name
as)) [Decl (Lexeme SId)]
decls
[Decl (Lexeme SId)] -> M a [Decl (Lexeme SId)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl (Lexeme SId)]
decls
dropCommon :: Name -> Name -> Name
dropCommon :: Name -> Name -> Name
dropCommon ([Text]
an,Text
a:[Text]
as) ([Text]
bn,Text
b:[Text]
bs) | Text -> Text
Text.toLower Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
Text.toLower Text
b = Name -> Name -> Name
dropCommon ([Text]
an,[Text]
as) ([Text]
bn,[Text]
bs)
dropCommon ([Text]
_,[]) Name
bs = Name
bs
dropCommon Name
as Name
bs = FilePath -> Name
forall a. HasCallStack => FilePath -> a
error (FilePath -> Name) -> FilePath -> Name
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
display Name
bs FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is not in the namespace of " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Name -> FilePath
display Name
as