{-# LANGUAGE CPP #-}
module Foreign.Hoppy.Generator.Language.Cpp.Internal (
Generation,
generate,
generatedFiles,
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad (when)
import Control.Monad.Writer (execWriterT, tell)
import Control.Monad.Trans (lift)
import Data.Foldable (forM_)
#if !MIN_VERSION_base(4,8,0)
import Data.Functor ((<$))
#endif
import qualified Data.Map as M
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mappend, mconcat, mempty)
#endif
import Foreign.Hoppy.Generator.Common
import Foreign.Hoppy.Generator.Language.Cpp
import Foreign.Hoppy.Generator.Spec
import Foreign.Hoppy.Generator.Types
newtype Generation = Generation
{ Generation -> Map FilePath FilePath
generatedFiles :: M.Map FilePath String
}
generate :: Interface -> ComputedInterfaceData -> Either ErrorMsg Generation
generate :: Interface -> ComputedInterfaceData -> Either FilePath Generation
generate Interface
iface ComputedInterfaceData
computed =
([(FilePath, FilePath)] -> Generation)
-> Either FilePath [(FilePath, FilePath)]
-> Either FilePath Generation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map FilePath FilePath -> Generation
Generation (Map FilePath FilePath -> Generation)
-> ([(FilePath, FilePath)] -> Map FilePath FilePath)
-> [(FilePath, FilePath)]
-> Generation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList) (Either FilePath [(FilePath, FilePath)]
-> Either FilePath Generation)
-> Either FilePath [(FilePath, FilePath)]
-> Either FilePath Generation
forall a b. (a -> b) -> a -> b
$
WriterT [(FilePath, FilePath)] (Either FilePath) ()
-> Either FilePath [(FilePath, FilePath)]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT [(FilePath, FilePath)] (Either FilePath) ()
-> Either FilePath [(FilePath, FilePath)])
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
-> Either FilePath [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$
[Module]
-> (Module -> WriterT [(FilePath, FilePath)] (Either FilePath) ())
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map FilePath Module -> [Module]
forall k a. Map k a -> [a]
M.elems (Map FilePath Module -> [Module])
-> Map FilePath Module -> [Module]
forall a b. (a -> b) -> a -> b
$ Interface -> Map FilePath Module
interfaceModules Interface
iface) ((Module -> WriterT [(FilePath, FilePath)] (Either FilePath) ())
-> WriterT [(FilePath, FilePath)] (Either FilePath) ())
-> (Module -> WriterT [(FilePath, FilePath)] (Either FilePath) ())
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
forall a b. (a -> b) -> a -> b
$ \Module
m -> do
let headerGuard :: FilePath
headerGuard = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
"HOPPY_MODULE_", Interface -> FilePath
interfaceName Interface
iface, FilePath
"_", Module -> FilePath
moduleName Module
m]
FilePath
header <- Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath)
-> Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath
forall a b. (a -> b) -> a -> b
$ Interface
-> ComputedInterfaceData
-> Module
-> Maybe FilePath
-> Generator ()
-> Either FilePath FilePath
forall a.
Interface
-> ComputedInterfaceData
-> Module
-> Maybe FilePath
-> Generator a
-> Either FilePath FilePath
execGenerator Interface
iface ComputedInterfaceData
computed Module
m (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
headerGuard) Generator ()
sayModuleHeader
[(FilePath, FilePath)]
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(Module -> FilePath
moduleHppPath Module
m, FilePath
header)]
FilePath
source <- Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath)
-> Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath
forall a b. (a -> b) -> a -> b
$ Interface
-> ComputedInterfaceData
-> Module
-> Maybe FilePath
-> Generator ()
-> Either FilePath FilePath
forall a.
Interface
-> ComputedInterfaceData
-> Module
-> Maybe FilePath
-> Generator a
-> Either FilePath FilePath
execGenerator Interface
iface ComputedInterfaceData
computed Module
m Maybe FilePath
forall a. Maybe a
Nothing Generator ()
sayModuleSource
[(FilePath, FilePath)]
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(Module -> FilePath
moduleCppPath Module
m, FilePath
source)]
sayModuleHeader :: Generator ()
= do
Module
m <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Module
forall (m :: * -> *). MonadReader Env m => m Module
askModule
Reqs -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => Reqs -> m ()
addReqsM (Reqs -> Generator ()) -> Reqs -> Generator ()
forall a b. (a -> b) -> a -> b
$ Module -> Reqs
moduleReqs Module
m
(Export -> Generator ()) -> [Export] -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SayExportMode -> Export -> Generator ()
forall a. Exportable a => SayExportMode -> a -> Generator ()
sayExportCpp SayExportMode
SayHeader) ([Export] -> Generator ()) -> [Export] -> Generator ()
forall a b. (a -> b) -> a -> b
$ Map ExtName Export -> [Export]
forall k a. Map k a -> [a]
M.elems (Map ExtName Export -> [Export]) -> Map ExtName Export -> [Export]
forall a b. (a -> b) -> a -> b
$ Module -> Map ExtName Export
moduleExports Module
m
Interface
iface <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Interface
forall (m :: * -> *). MonadReader Env m => m Interface
askInterface
Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Interface -> Maybe Module
interfaceExceptionSupportModule Interface
iface Maybe Module -> Maybe Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Maybe Module
forall a. a -> Maybe a
Just Module
m) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$
Bool -> Generator ()
sayExceptionSupport Bool
False
sayModuleSource :: Generator ()
sayModuleSource :: Generator ()
sayModuleSource = do
Module
m <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Module
forall (m :: * -> *). MonadReader Env m => m Module
askModule
Include -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => Include -> m ()
addInclude (Include -> Generator ()) -> Include -> Generator ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Include
includeLocal (FilePath -> Include) -> FilePath -> Include
forall a b. (a -> b) -> a -> b
$ Module -> FilePath
moduleHppPath Module
m
(Export -> Generator ()) -> [Export] -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SayExportMode -> Export -> Generator ()
forall a. Exportable a => SayExportMode -> a -> Generator ()
sayExportCpp SayExportMode
SaySource) ([Export] -> Generator ()) -> [Export] -> Generator ()
forall a b. (a -> b) -> a -> b
$ Map ExtName Export -> [Export]
forall k a. Map k a -> [a]
M.elems (Map ExtName Export -> [Export]) -> Map ExtName Export -> [Export]
forall a b. (a -> b) -> a -> b
$ Module -> Map ExtName Export
moduleExports Module
m
Interface
iface <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Interface
forall (m :: * -> *). MonadReader Env m => m Interface
askInterface
Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Interface -> Maybe Module
interfaceExceptionSupportModule Interface
iface Maybe Module -> Maybe Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Maybe Module
forall a. a -> Maybe a
Just Module
m) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$
Bool -> Generator ()
sayExceptionSupport Bool
True
sayExceptionSupport :: Bool -> Generator ()
sayExceptionSupport :: Bool -> Generator ()
sayExceptionSupport Bool
sayBody =
FilePath
-> [FilePath] -> Type -> Maybe (Generator ()) -> Generator ()
sayFunction FilePath
exceptionRethrowFnName
[FilePath
"excId", FilePath
"voidPtr"]
([Type] -> Type -> Type
fnT [Type
intT, Type -> Type
ptrT Type
voidT] Type
voidT) (Maybe (Generator ()) -> Generator ())
-> Maybe (Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$
if Bool -> Bool
not Bool
sayBody
then Maybe (Generator ())
forall a. Maybe a
Nothing
else Generator () -> Maybe (Generator ())
forall a. a -> Maybe a
Just (Generator () -> Maybe (Generator ()))
-> Generator () -> Maybe (Generator ())
forall a b. (a -> b) -> a -> b
$ do
Interface
iface <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Interface
forall (m :: * -> *). MonadReader Env m => m Interface
askInterface
let excClasses :: [Class]
excClasses = Interface -> [Class]
interfaceAllExceptionClasses Interface
iface
[FilePath] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [FilePath] -> m ()
says [FilePath
"switch (excId) {\n"]
[Class] -> (Class -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Class]
excClasses ((Class -> Generator ()) -> Generator ())
-> (Class -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \Class
cls -> do
Int
excId <- (ExceptionId -> Int)
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExceptionId -> Int
getExceptionId (ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) Int)
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) Int
forall a b. (a -> b) -> a -> b
$
ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
-> Maybe ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM (FilePath
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
forall a. FilePath -> Generator a
abort (FilePath
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId)
-> FilePath
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
forall a b. (a -> b) -> a -> b
$ FilePath
"sayExceptionSupport: Internal error, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Class -> FilePath
forall a. Show a => a -> FilePath
show Class
cls FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
"should have an exception ID, but doesn't.") (Maybe ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId)
-> Maybe ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
forall a b. (a -> b) -> a -> b
$
Interface -> Class -> Maybe ExceptionId
interfaceExceptionClassId Interface
iface Class
cls
[FilePath] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [FilePath] -> m ()
says [FilePath
"case ", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
excId, FilePath
": {\n"]
FilePath -> Maybe [FilePath] -> Type -> Generator ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
FilePath -> Maybe [FilePath] -> Type -> m ()
sayVar FilePath
"excPtr" Maybe [FilePath]
forall a. Maybe a
Nothing (Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls) Generator () -> Generator () -> Generator ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
" = reinterpret_cast<" Generator () -> Generator () -> Generator ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Maybe [FilePath] -> Type -> Generator ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Maybe [FilePath] -> Type -> m ()
sayType Maybe [FilePath]
forall a. Maybe a
Nothing (Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls) Generator () -> Generator () -> Generator ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [FilePath] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [FilePath] -> m ()
says [FilePath
">(voidPtr);\n"]
FilePath -> Maybe [FilePath] -> Type -> Generator ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
FilePath -> Maybe [FilePath] -> Type -> m ()
sayVar FilePath
"exc" Maybe [FilePath]
forall a. Maybe a
Nothing (Class -> Type
objT Class
cls) Generator () -> Generator () -> Generator ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
" = *excPtr;\n"
FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
"delete excPtr;\n"
FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
"throw exc;\n"
FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
"}\n"
FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
"}\n"
[FilePath] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [FilePath] -> m ()
says [FilePath
"throw \"Internal Hoppy error, ", FilePath
exceptionRethrowFnName,
FilePath
" got an unknown exception ID.\";\n"]