{-# LANGUAGE ViewPatterns #-}
module Foreign.Hoppy.Generator.Language.Cpp (
Generator,
Env,
execGenerator,
addIncludes, addInclude, addReqsM,
askInterface, askComputedInterfaceData, askModule, abort,
makeCppName,
externalNameToCpp,
toArgName,
toArgNameAlt,
exceptionIdArgName,
exceptionPtrArgName,
exceptionVarName,
exceptionRethrowFnName,
Chunk (..),
codeChunk,
includesChunk,
runChunkWriter,
evalChunkWriter,
execChunkWriter,
runChunkWriterT,
evalChunkWriterT,
execChunkWriterT,
SayExportMode (..),
say,
says,
sayIdentifier,
renderIdentifier,
sayVar,
sayType,
sayFunction,
typeToCType,
typeReqs,
findExportModule,
getEffectiveExceptionHandlers,
) where
import Control.Monad (unless)
import Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT)
import Control.Monad.Writer (MonadWriter, Writer, WriterT, runWriter, runWriterT, tell)
import Control.Monad.Trans (lift)
import Data.Foldable (forM_)
import Data.List (intercalate, intersperse)
import qualified Data.Map as M
import qualified Data.Set as S
import Foreign.Hoppy.Generator.Common
import Foreign.Hoppy.Generator.Spec.Base
import Foreign.Hoppy.Generator.Spec.Computed (ComputedInterfaceData)
import {-# SOURCE #-} Foreign.Hoppy.Generator.Spec.Class (classIdentifier, classReqs)
import Foreign.Hoppy.Generator.Types
type Generator = ReaderT Env (WriterT [Chunk] (Either ErrorMsg))
data Env = Env
{ Env -> Interface
envInterface :: Interface
, Env -> ComputedInterfaceData
envComputedInterfaceData :: ComputedInterfaceData
, Env -> Module
envModule :: Module
}
execGenerator ::
Interface
-> ComputedInterfaceData
-> Module
-> Maybe String
-> Generator a
-> Either ErrorMsg String
execGenerator :: Interface
-> ComputedInterfaceData
-> Module
-> Maybe String
-> Generator a
-> Either String String
execGenerator Interface
iface ComputedInterfaceData
computed Module
m Maybe String
maybeHeaderGuardName Generator a
action = do
Chunk
chunk <- WriterT [Chunk] (Either String) a -> Either String Chunk
forall (m :: * -> *) a. Monad m => WriterT [Chunk] m a -> m Chunk
execChunkWriterT (WriterT [Chunk] (Either String) a -> Either String Chunk)
-> WriterT [Chunk] (Either String) a -> Either String Chunk
forall a b. (a -> b) -> a -> b
$ Generator a -> Env -> WriterT [Chunk] (Either String) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Generator a
action (Env -> WriterT [Chunk] (Either String) a)
-> Env -> WriterT [Chunk] (Either String) a
forall a b. (a -> b) -> a -> b
$ Interface -> ComputedInterfaceData -> Module -> Env
Env Interface
iface ComputedInterfaceData
computed Module
m
let contents :: String
contents = Chunk -> String
chunkContents Chunk
chunk
includes :: Set Include
includes = Chunk -> Set Include
chunkIncludes Chunk
chunk
String -> Either String String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ Chunk -> String
chunkContents (Chunk -> String) -> Chunk -> String
forall a b. (a -> b) -> a -> b
$ Writer [Chunk] () -> Chunk
forall a. Writer [Chunk] a -> Chunk
execChunkWriter (Writer [Chunk] () -> Chunk) -> Writer [Chunk] () -> Chunk
forall a b. (a -> b) -> a -> b
$ do
String -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"////////// GENERATED FILE, EDITS WILL BE LOST //////////\n"
Maybe String -> (String -> Writer [Chunk] ()) -> Writer [Chunk] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
maybeHeaderGuardName ((String -> Writer [Chunk] ()) -> Writer [Chunk] ())
-> (String -> Writer [Chunk] ()) -> Writer [Chunk] ()
forall a b. (a -> b) -> a -> b
$ \String
x -> do
[String] -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => [String] -> m ()
says [String
"\n#ifndef ", String
x, String
"\n"]
[String] -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => [String] -> m ()
says [String
"#define ", String
x, String
"\n"]
Bool -> Writer [Chunk] () -> Writer [Chunk] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Include -> Bool
forall a. Set a -> Bool
S.null Set Include
includes) (Writer [Chunk] () -> Writer [Chunk] ())
-> Writer [Chunk] () -> Writer [Chunk] ()
forall a b. (a -> b) -> a -> b
$ do
String -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"\n"
Set Include -> (Include -> Writer [Chunk] ()) -> Writer [Chunk] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set Include
includes ((Include -> Writer [Chunk] ()) -> Writer [Chunk] ())
-> (Include -> Writer [Chunk] ()) -> Writer [Chunk] ()
forall a b. (a -> b) -> a -> b
$ String -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say (String -> Writer [Chunk] ())
-> (Include -> String) -> Include -> Writer [Chunk] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Include -> String
includeToString
String -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"\nextern \"C\" {\n"
String -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
contents
String -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"\n} // extern \"C\"\n"
Maybe String -> (String -> Writer [Chunk] ()) -> Writer [Chunk] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
maybeHeaderGuardName ((String -> Writer [Chunk] ()) -> Writer [Chunk] ())
-> (String -> Writer [Chunk] ()) -> Writer [Chunk] ()
forall a b. (a -> b) -> a -> b
$ \String
x ->
[String] -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => [String] -> m ()
says [String
"\n#endif // ifndef ", String
x, String
"\n"]
addIncludes :: MonadWriter [Chunk] m => [Include] -> m ()
addIncludes :: [Include] -> m ()
addIncludes = [Chunk] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Chunk] -> m ()) -> ([Include] -> [Chunk]) -> [Include] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:[]) (Chunk -> [Chunk]) -> ([Include] -> Chunk) -> [Include] -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Include -> Chunk
includesChunk (Set Include -> Chunk)
-> ([Include] -> Set Include) -> [Include] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Include] -> Set Include
forall a. Ord a => [a] -> Set a
S.fromList
addInclude :: MonadWriter [Chunk] m => Include -> m ()
addInclude :: Include -> m ()
addInclude = [Include] -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => [Include] -> m ()
addIncludes ([Include] -> m ()) -> (Include -> [Include]) -> Include -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Include -> [Include] -> [Include]
forall a. a -> [a] -> [a]
:[])
addReqsM :: MonadWriter [Chunk] m => Reqs -> m ()
addReqsM :: Reqs -> m ()
addReqsM = [Chunk] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Chunk] -> m ()) -> (Reqs -> [Chunk]) -> Reqs -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:[]) (Chunk -> [Chunk]) -> (Reqs -> Chunk) -> Reqs -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Include -> Chunk
includesChunk (Set Include -> Chunk) -> (Reqs -> Set Include) -> Reqs -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reqs -> Set Include
reqsIncludes
askInterface :: MonadReader Env m => m Interface
askInterface :: m Interface
askInterface = (Env -> Interface) -> m Env -> m Interface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Env -> Interface
envInterface m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
askComputedInterfaceData :: Generator ComputedInterfaceData
askComputedInterfaceData :: Generator ComputedInterfaceData
askComputedInterfaceData = (Env -> ComputedInterfaceData)
-> ReaderT Env (WriterT [Chunk] (Either String)) Env
-> Generator ComputedInterfaceData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Env -> ComputedInterfaceData
envComputedInterfaceData ReaderT Env (WriterT [Chunk] (Either String)) Env
forall r (m :: * -> *). MonadReader r m => m r
ask
askModule :: MonadReader Env m => m Module
askModule :: m Module
askModule = (Env -> Module) -> m Env -> m Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Env -> Module
envModule m Env
forall r (m :: * -> *). MonadReader r m => m r
ask
abort :: ErrorMsg -> Generator a
abort :: String -> Generator a
abort = WriterT [Chunk] (Either String) a -> Generator a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [Chunk] (Either String) a -> Generator a)
-> (String -> WriterT [Chunk] (Either String) a)
-> String
-> Generator a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String a -> WriterT [Chunk] (Either String) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String a -> WriterT [Chunk] (Either String) a)
-> (String -> Either String a)
-> String
-> WriterT [Chunk] (Either String) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left
makeCppName :: [String] -> String
makeCppName :: [String] -> String
makeCppName = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
cppNameSeparator
where cppNameSeparator :: String
cppNameSeparator = String
"__"
externalNamePrefix :: String
externalNamePrefix :: String
externalNamePrefix = String
"genpop"
externalNameToCpp :: ExtName -> String
externalNameToCpp :: ExtName -> String
externalNameToCpp ExtName
extName =
[String] -> String
makeCppName [String
externalNamePrefix, ExtName -> String
fromExtName ExtName
extName]
toArgName :: Int -> String
toArgName :: Int -> String
toArgName = (String
"arg" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
toArgNameAlt :: Int -> String
toArgNameAlt :: Int -> String
toArgNameAlt Int
n = String
"arg" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
exceptionIdArgName :: String
exceptionIdArgName :: String
exceptionIdArgName = String
"excId"
exceptionPtrArgName :: String
exceptionPtrArgName :: String
exceptionPtrArgName = String
"excPtr"
exceptionVarName :: String
exceptionVarName :: String
exceptionVarName = String
"exc_"
exceptionRethrowFnName :: String
exceptionRethrowFnName :: String
exceptionRethrowFnName = String
"genthrow"
isIdentifierChar :: Char -> Bool
isIdentifierChar :: Char -> Bool
isIdentifierChar = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
identifierChars)
identifierChars :: String
identifierChars :: String
identifierChars = [Char
'A'..Char
'Z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
data Chunk = Chunk
{ Chunk -> String
chunkContents :: !String
, Chunk -> Set Include
chunkIncludes :: !(S.Set Include)
}
codeChunk :: String -> Chunk
codeChunk :: String -> Chunk
codeChunk String
code =
Chunk :: String -> Set Include -> Chunk
Chunk
{ chunkContents :: String
chunkContents = String
code
, chunkIncludes :: Set Include
chunkIncludes = Set Include
forall a. Set a
S.empty
}
includesChunk :: S.Set Include -> Chunk
includesChunk :: Set Include -> Chunk
includesChunk Set Include
includes =
Chunk :: String -> Set Include -> Chunk
Chunk
{ chunkContents :: String
chunkContents = String
""
, chunkIncludes :: Set Include
chunkIncludes = Set Include
includes
}
runChunkWriter :: Writer [Chunk] a -> (a, Chunk)
runChunkWriter :: Writer [Chunk] a -> (a, Chunk)
runChunkWriter = ([Chunk] -> Chunk) -> (a, [Chunk]) -> (a, Chunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Chunk] -> Chunk
combineChunks ((a, [Chunk]) -> (a, Chunk))
-> (Writer [Chunk] a -> (a, [Chunk]))
-> Writer [Chunk] a
-> (a, Chunk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer [Chunk] a -> (a, [Chunk])
forall w a. Writer w a -> (a, w)
runWriter
evalChunkWriter :: Writer [Chunk] a -> a
evalChunkWriter :: Writer [Chunk] a -> a
evalChunkWriter = (a, Chunk) -> a
forall a b. (a, b) -> a
fst ((a, Chunk) -> a)
-> (Writer [Chunk] a -> (a, Chunk)) -> Writer [Chunk] a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer [Chunk] a -> (a, Chunk)
forall a. Writer [Chunk] a -> (a, Chunk)
runChunkWriter
execChunkWriter :: Writer [Chunk] a -> Chunk
execChunkWriter :: Writer [Chunk] a -> Chunk
execChunkWriter = (a, Chunk) -> Chunk
forall a b. (a, b) -> b
snd ((a, Chunk) -> Chunk)
-> (Writer [Chunk] a -> (a, Chunk)) -> Writer [Chunk] a -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer [Chunk] a -> (a, Chunk)
forall a. Writer [Chunk] a -> (a, Chunk)
runChunkWriter
runChunkWriterT :: Monad m => WriterT [Chunk] m a -> m (a, Chunk)
runChunkWriterT :: WriterT [Chunk] m a -> m (a, Chunk)
runChunkWriterT = ((a, [Chunk]) -> (a, Chunk)) -> m (a, [Chunk]) -> m (a, Chunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Chunk] -> Chunk) -> (a, [Chunk]) -> (a, Chunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Chunk] -> Chunk
combineChunks) (m (a, [Chunk]) -> m (a, Chunk))
-> (WriterT [Chunk] m a -> m (a, [Chunk]))
-> WriterT [Chunk] m a
-> m (a, Chunk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [Chunk] m a -> m (a, [Chunk])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
evalChunkWriterT :: Monad m => WriterT [Chunk] m a -> m a
evalChunkWriterT :: WriterT [Chunk] m a -> m a
evalChunkWriterT = ((a, Chunk) -> a) -> m (a, Chunk) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Chunk) -> a
forall a b. (a, b) -> a
fst (m (a, Chunk) -> m a)
-> (WriterT [Chunk] m a -> m (a, Chunk))
-> WriterT [Chunk] m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [Chunk] m a -> m (a, Chunk)
forall (m :: * -> *) a.
Monad m =>
WriterT [Chunk] m a -> m (a, Chunk)
runChunkWriterT
execChunkWriterT :: Monad m => WriterT [Chunk] m a -> m Chunk
execChunkWriterT :: WriterT [Chunk] m a -> m Chunk
execChunkWriterT = ((a, Chunk) -> Chunk) -> m (a, Chunk) -> m Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Chunk) -> Chunk
forall a b. (a, b) -> b
snd (m (a, Chunk) -> m Chunk)
-> (WriterT [Chunk] m a -> m (a, Chunk))
-> WriterT [Chunk] m a
-> m Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [Chunk] m a -> m (a, Chunk)
forall (m :: * -> *) a.
Monad m =>
WriterT [Chunk] m a -> m (a, Chunk)
runChunkWriterT
combineChunks :: [Chunk] -> Chunk
combineChunks :: [Chunk] -> Chunk
combineChunks [Chunk]
chunks =
let strs :: [String]
strs = (Chunk -> String) -> [Chunk] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> String
chunkContents [Chunk]
chunks
in Chunk :: String -> Set Include -> Chunk
Chunk
{ chunkContents :: String
chunkContents =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> ((String, String) -> String) -> [String]
forall a b. [a] -> (a -> b) -> [b]
for ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String
""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
strs) [String]
strs) (((String, String) -> String) -> [String])
-> ((String, String) -> String) -> [String]
forall a b. (a -> b) -> a -> b
$ \(String
prev, String
cur) ->
let needsSpace :: Bool
needsSpace =
Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
prev) Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cur) Bool -> Bool -> Bool
&&
(let a :: Char
a = String -> Char
forall a. [a] -> a
last String
prev
b :: Char
b = String -> Char
forall a. [a] -> a
head String
cur
in
Char -> Bool
isIdentifierChar Char
a Bool -> Bool -> Bool
&& Char -> Bool
isIdentifierChar Char
b Bool -> Bool -> Bool
||
Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>' Bool -> Bool -> Bool
&& Char
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>')
in if Bool
needsSpace then Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
cur else String
cur
, chunkIncludes :: Set Include
chunkIncludes = [Set Include] -> Set Include
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set Include] -> Set Include) -> [Set Include] -> Set Include
forall a b. (a -> b) -> a -> b
$ (Chunk -> Set Include) -> [Chunk] -> [Set Include]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Set Include
chunkIncludes [Chunk]
chunks
}
data SayExportMode =
SaySource
|
say :: MonadWriter [Chunk] m => String -> m ()
say :: String -> m ()
say = [Chunk] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Chunk] -> m ()) -> (String -> [Chunk]) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:[]) (Chunk -> [Chunk]) -> (String -> Chunk) -> String -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Chunk
codeChunk
says :: MonadWriter [Chunk] m => [String] -> m ()
says :: [String] -> m ()
says = [Chunk] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Chunk] -> m ()) -> ([String] -> [Chunk]) -> [String] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Chunk) -> [String] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map String -> Chunk
codeChunk
sayIdentifier :: MonadWriter [Chunk] m => Identifier -> m ()
sayIdentifier :: Identifier -> m ()
sayIdentifier =
[m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([m ()] -> m ()) -> (Identifier -> [m ()]) -> Identifier -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> [m ()] -> [m ()]
forall a. a -> [a] -> [a]
intersperse (String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"::") ([m ()] -> [m ()])
-> (Identifier -> [m ()]) -> Identifier -> [m ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdPart -> m ()) -> [IdPart] -> [m ()]
forall a b. (a -> b) -> [a] -> [b]
map IdPart -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => IdPart -> m ()
renderPart ([IdPart] -> [m ()])
-> (Identifier -> [IdPart]) -> Identifier -> [m ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> [IdPart]
identifierParts
where renderPart :: IdPart -> m ()
renderPart IdPart
part = do
String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ IdPart -> String
idPartBase IdPart
part
case IdPart -> Maybe [Type]
idPartArgs IdPart
part of
Maybe [Type]
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [Type]
args -> do
String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"<"
[m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([m ()] -> m ()) -> [m ()] -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> [m ()] -> [m ()]
forall a. a -> [a] -> [a]
intersperse (String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
", ") ([m ()] -> [m ()]) -> [m ()] -> [m ()]
forall a b. (a -> b) -> a -> b
$ (Type -> m ()) -> [Type] -> [m ()]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe [String] -> Type -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Maybe [String] -> Type -> m ()
sayType Maybe [String]
forall a. Maybe a
Nothing) [Type]
args
String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
">"
renderIdentifier :: Identifier -> String
renderIdentifier :: Identifier -> String
renderIdentifier = Chunk -> String
chunkContents (Chunk -> String) -> (Identifier -> Chunk) -> Identifier -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer [Chunk] () -> Chunk
forall a. Writer [Chunk] a -> Chunk
execChunkWriter (Writer [Chunk] () -> Chunk)
-> (Identifier -> Writer [Chunk] ()) -> Identifier -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Writer [Chunk] ()
forall (m :: * -> *). MonadWriter [Chunk] m => Identifier -> m ()
sayIdentifier
sayVar :: MonadWriter [Chunk] m => String -> Maybe [String] -> Type -> m ()
sayVar :: String -> Maybe [String] -> Type -> m ()
sayVar String
name Maybe [String]
maybeParamNames Type
t = Type -> Maybe [String] -> Int -> m () -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Type -> Maybe [String] -> Int -> m () -> m ()
sayType' Type
t Maybe [String]
maybeParamNames Int
topPrecedence (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
name
sayType :: MonadWriter [Chunk] m => Maybe [String] -> Type -> m ()
sayType :: Maybe [String] -> Type -> m ()
sayType Maybe [String]
maybeParamNames Type
t = Type -> Maybe [String] -> Int -> m () -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Type -> Maybe [String] -> Int -> m () -> m ()
sayType' Type
t Maybe [String]
maybeParamNames Int
topPrecedence (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sayType' :: MonadWriter [Chunk] m => Type -> Maybe [String] -> Int -> m () -> m ()
sayType' :: Type -> Maybe [String] -> Int -> m () -> m ()
sayType' (Type -> Type
normalizeType -> Type
t) Maybe [String]
maybeParamNames Int
outerPrec m ()
unwrappedOuter =
let prec :: Int
prec = Type -> Int
typePrecedence Type
t
outer :: m ()
outer = if Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
outerPrec
then m ()
unwrappedOuter
else String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"(" m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
unwrappedOuter m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
")"
in case Type
t of
Type
Internal_TVoid -> String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"void" m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
outer
Internal_TPtr Type
t' -> Type -> Maybe [String] -> Int -> m () -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Type -> Maybe [String] -> Int -> m () -> m ()
sayType' Type
t' Maybe [String]
forall a. Maybe a
Nothing Int
prec (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"*" m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
outer
Internal_TRef Type
t' -> Type -> Maybe [String] -> Int -> m () -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Type -> Maybe [String] -> Int -> m () -> m ()
sayType' Type
t' Maybe [String]
forall a. Maybe a
Nothing Int
prec (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"&" m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
outer
Internal_TFn [Parameter]
params Type
retType -> Type -> Maybe [String] -> Int -> m () -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Type -> Maybe [String] -> Int -> m () -> m ()
sayType' Type
retType Maybe [String]
forall a. Maybe a
Nothing Int
prec (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
m ()
outer
String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"("
[m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([m ()] -> m ()) -> [m ()] -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> [m ()] -> [m ()]
forall a. a -> [a] -> [a]
intersperse (String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
", ") ([m ()] -> [m ()]) -> [m ()] -> [m ()]
forall a b. (a -> b) -> a -> b
$
[(Parameter, Maybe String)]
-> ((Parameter, Maybe String) -> m ()) -> [m ()]
forall a b. [a] -> (a -> b) -> [b]
for ([Parameter] -> [Maybe String] -> [(Parameter, Maybe String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Parameter]
params ([Maybe String] -> [(Parameter, Maybe String)])
-> [Maybe String] -> [(Parameter, Maybe String)]
forall a b. (a -> b) -> a -> b
$ [Maybe String]
-> ([String] -> [Maybe String]) -> Maybe [String] -> [Maybe String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe String -> [Maybe String]
forall a. a -> [a]
repeat Maybe String
forall a. Maybe a
Nothing) ((String -> Maybe String) -> [String] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe String
forall a. a -> Maybe a
Just) (Maybe [String] -> [Maybe String])
-> Maybe [String] -> [Maybe String]
forall a b. (a -> b) -> a -> b
$ Maybe [String]
maybeParamNames) (((Parameter, Maybe String) -> m ()) -> [m ()])
-> ((Parameter, Maybe String) -> m ()) -> [m ()]
forall a b. (a -> b) -> a -> b
$
\(Parameter
param, Maybe String
pname) ->
Type -> Maybe [String] -> Int -> m () -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Type -> Maybe [String] -> Int -> m () -> m ()
sayType' (Parameter -> Type
parameterType Parameter
param) Maybe [String]
forall a. Maybe a
Nothing Int
topPrecedence (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> (String -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
pname String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say
String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
")"
Internal_TObj Class
cls -> Identifier -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => Identifier -> m ()
sayIdentifier (Class -> Identifier
classIdentifier Class
cls) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
outer
Internal_TObjToHeap Class
cls ->
Type -> Maybe [String] -> Int -> m () -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Type -> Maybe [String] -> Int -> m () -> m ()
sayType' (Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls) Maybe [String]
maybeParamNames Int
outerPrec m ()
unwrappedOuter
Internal_TToGc Type
t' -> Type -> Maybe [String] -> Int -> m () -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Type -> Maybe [String] -> Int -> m () -> m ()
sayType' Type
t' Maybe [String]
maybeParamNames Int
outerPrec m ()
unwrappedOuter
Internal_TManual ConversionSpec
s -> String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say (ConversionSpecCpp -> String
conversionSpecCppName (ConversionSpecCpp -> String) -> ConversionSpecCpp -> String
forall a b. (a -> b) -> a -> b
$ ConversionSpec -> ConversionSpecCpp
conversionSpecCpp ConversionSpec
s) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
outer
Internal_TConst Type
t' -> Type -> Maybe [String] -> Int -> m () -> m ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Type -> Maybe [String] -> Int -> m () -> m ()
sayType' Type
t' Maybe [String]
maybeParamNames Int
outerPrec (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"const" m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
unwrappedOuter
topPrecedence :: Int
topPrecedence :: Int
topPrecedence = Int
11
typePrecedence :: Type -> Int
typePrecedence :: Type -> Int
typePrecedence Type
t = case Type
t of
Internal_TFn {} -> Int
10
Internal_TPtr {} -> Int
9
Internal_TRef {} -> Int
9
Type
_ -> Int
8
sayFunction ::
String
-> [String]
-> Type
-> Maybe (Generator ())
-> Generator ()
sayFunction :: String -> [String] -> Type -> Maybe (Generator ()) -> Generator ()
sayFunction String
name [String]
paramNames Type
t Maybe (Generator ())
maybeBody = do
case Type
t of
Internal_TFn {} -> () -> Generator ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Type
_ -> String -> Generator ()
forall a. String -> Generator a
abort (String -> Generator ()) -> String -> Generator ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"sayFunction: A function type is required, given ", Type -> String
forall a. Show a => a -> String
show Type
t, String
"."]
String -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"\n"
String -> Maybe [String] -> Type -> Generator ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
String -> Maybe [String] -> Type -> m ()
sayVar String
name ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
paramNames) Type
t
case Maybe (Generator ())
maybeBody of
Maybe (Generator ())
Nothing -> String -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
";\n"
Just Generator ()
body -> do
String -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
" {\n"
Generator ()
body
String -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"}\n"
typeToCType :: Type -> Generator (Maybe Type)
typeToCType :: Type -> Generator (Maybe Type)
typeToCType Type
t = case Type
t of
Internal_TRef Type
t' -> Maybe Type -> Generator (Maybe Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type -> Generator (Maybe Type))
-> Maybe Type -> Generator (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT Type
t'
Internal_TObj Class
_ -> Maybe Type -> Generator (Maybe Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type -> Generator (Maybe Type))
-> Maybe Type -> Generator (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
t
Internal_TObjToHeap Class
cls -> Maybe Type -> Generator (Maybe Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type -> Generator (Maybe Type))
-> Maybe Type -> Generator (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls
Internal_TToGc t' :: Type
t'@(Internal_TObj Class
_) -> Maybe Type -> Generator (Maybe Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type -> Generator (Maybe Type))
-> Maybe Type -> Generator (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT Type
t'
Internal_TToGc Type
t' -> Type -> Generator (Maybe Type)
typeToCType Type
t'
Internal_TConst Type
t' -> Type -> Generator (Maybe Type)
typeToCType Type
t'
Internal_TManual ConversionSpec
s -> ConversionSpecCpp -> Generator (Maybe Type)
conversionSpecCppConversionType (ConversionSpecCpp -> Generator (Maybe Type))
-> ConversionSpecCpp -> Generator (Maybe Type)
forall a b. (a -> b) -> a -> b
$ ConversionSpec -> ConversionSpecCpp
conversionSpecCpp ConversionSpec
s
Type
_ -> Maybe Type -> Generator (Maybe Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Type
forall a. Maybe a
Nothing
typeReqs :: Type -> Generator Reqs
typeReqs :: Type -> Generator Reqs
typeReqs Type
t = case Type
t of
Type
Internal_TVoid -> Reqs -> Generator Reqs
forall (m :: * -> *) a. Monad m => a -> m a
return Reqs
forall a. Monoid a => a
mempty
Internal_TPtr Type
t' -> Type -> Generator Reqs
typeReqs Type
t'
Internal_TRef Type
t' -> Type -> Generator Reqs
typeReqs Type
t'
Internal_TFn [Parameter]
params Type
retType ->
[Reqs] -> Reqs
forall a. Monoid a => [a] -> a
mconcat ([Reqs] -> Reqs)
-> ReaderT Env (WriterT [Chunk] (Either String)) [Reqs]
-> Generator Reqs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Generator Reqs)
-> [Type] -> ReaderT Env (WriterT [Chunk] (Either String)) [Reqs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Generator Reqs
typeReqs (Type
retType Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: (Parameter -> Type) -> [Parameter] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Parameter -> Type
parameterType [Parameter]
params)
Internal_TObj Class
cls -> Reqs -> Generator Reqs
forall (m :: * -> *) a. Monad m => a -> m a
return (Reqs -> Generator Reqs) -> Reqs -> Generator Reqs
forall a b. (a -> b) -> a -> b
$ Class -> Reqs
classReqs Class
cls
Internal_TObjToHeap Class
cls -> Reqs -> Generator Reqs
forall (m :: * -> *) a. Monad m => a -> m a
return (Reqs -> Generator Reqs) -> Reqs -> Generator Reqs
forall a b. (a -> b) -> a -> b
$ Class -> Reqs
classReqs Class
cls
Internal_TToGc Type
t' -> Type -> Generator Reqs
typeReqs Type
t'
Internal_TConst Type
t' -> Type -> Generator Reqs
typeReqs Type
t'
Internal_TManual ConversionSpec
s -> ConversionSpecCpp -> Generator Reqs
conversionSpecCppReqs (ConversionSpecCpp -> Generator Reqs)
-> ConversionSpecCpp -> Generator Reqs
forall a b. (a -> b) -> a -> b
$ ConversionSpec -> ConversionSpecCpp
conversionSpecCpp ConversionSpec
s
findExportModule :: ExtName -> Generator Module
findExportModule :: ExtName -> Generator Module
findExportModule ExtName
extName =
Generator Module -> Maybe Module -> Generator Module
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM (String -> Generator Module
forall a. String -> Generator a
abort (String -> Generator Module) -> String -> Generator Module
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
"findExportModule: Can't find module exporting ", ExtName -> String
fromExtName ExtName
extName, String
"."]) (Maybe Module -> Generator Module)
-> ReaderT Env (WriterT [Chunk] (Either String)) (Maybe Module)
-> Generator Module
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
(Interface -> Maybe Module)
-> ReaderT Env (WriterT [Chunk] (Either String)) Interface
-> ReaderT Env (WriterT [Chunk] (Either String)) (Maybe Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExtName -> Map ExtName Module -> Maybe Module
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ExtName
extName (Map ExtName Module -> Maybe Module)
-> (Interface -> Map ExtName Module) -> Interface -> Maybe Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Map ExtName Module
interfaceNamesToModules) ReaderT Env (WriterT [Chunk] (Either String)) Interface
forall (m :: * -> *). MonadReader Env m => m Interface
askInterface
getEffectiveExceptionHandlers :: ExceptionHandlers -> Generator ExceptionHandlers
getEffectiveExceptionHandlers :: ExceptionHandlers -> Generator ExceptionHandlers
getEffectiveExceptionHandlers ExceptionHandlers
handlers = do
ExceptionHandlers
ifaceHandlers <- Interface -> ExceptionHandlers
interfaceExceptionHandlers (Interface -> ExceptionHandlers)
-> ReaderT Env (WriterT [Chunk] (Either String)) Interface
-> Generator ExceptionHandlers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Env (WriterT [Chunk] (Either String)) Interface
forall (m :: * -> *). MonadReader Env m => m Interface
askInterface
ExceptionHandlers
moduleHandlers <- Module -> ExceptionHandlers
forall a. HandlesExceptions a => a -> ExceptionHandlers
getExceptionHandlers (Module -> ExceptionHandlers)
-> Generator Module -> Generator ExceptionHandlers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Generator Module
forall (m :: * -> *). MonadReader Env m => m Module
askModule
ExceptionHandlers -> Generator ExceptionHandlers
forall (m :: * -> *) a. Monad m => a -> m a
return (ExceptionHandlers -> Generator ExceptionHandlers)
-> ExceptionHandlers -> Generator ExceptionHandlers
forall a b. (a -> b) -> a -> b
$ [ExceptionHandlers] -> ExceptionHandlers
forall a. Monoid a => [a] -> a
mconcat [ExceptionHandlers
handlers, ExceptionHandlers
moduleHandlers, ExceptionHandlers
ifaceHandlers]