-- This file is part of Hoppy.
--
-- Copyright 2015-2021 Bryan Gardiner <bog@khumba.net>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE ViewPatterns #-}

-- | Shared portion of the C++ code generator.  Usable by binding definitions.
module Foreign.Hoppy.Generator.Language.Cpp (
  -- * Code generation monad
  Generator,
  Env,
  execGenerator,
  addIncludes, addInclude, addReqsM,
  askInterface, askComputedInterfaceData, askModule, abort,
  -- * Names
  makeCppName,
  externalNameToCpp,
  toArgName,
  toArgNameAlt,
  exceptionIdArgName,
  exceptionPtrArgName,
  exceptionVarName,
  exceptionRethrowFnName,
  -- * Token rendering
  Chunk (..),
  codeChunk,
  includesChunk,
  runChunkWriter,
  evalChunkWriter,
  execChunkWriter,
  runChunkWriterT,
  evalChunkWriterT,
  execChunkWriterT,
  -- * High-level code generation
  SayExportMode (..),
  say,
  says,
  sayIdentifier,
  renderIdentifier,
  sayVar,
  sayType,
  sayFunction,
  -- * Auxiliary functions
  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

-- | A generator monad for C++ code.
--
-- TODO This should not simply be a type synonym.
type Generator = ReaderT Env (WriterT [Chunk] (Either ErrorMsg))

-- | Context information for generating C++ code.
data Env = Env
  { Env -> Interface
envInterface :: Interface
  , Env -> ComputedInterfaceData
envComputedInterfaceData :: ComputedInterfaceData
  , Env -> Module
envModule :: Module
  }

-- | Runs a generator action and returns its output, or an error message if
-- unsuccessful.
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"]

-- | Adds @#include@ statements to the includes block generated at the top of
-- the currently generating file.
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

-- | Adds an @#include@ statement to the includes block generated at the top of
-- the currently generating file.
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]
:[])

-- | Adds requirements ('Reqs' i.e. C++ includes) to the includes block
-- generated at the top of the currently generating file.
--
-- Have to call this @addReqsM@, 'addReqs' is taken by 'HasReqs'.
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

-- | Returns the currently generating interface.
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

-- | Returns the computed data for the currently generating interface.
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

-- | Returns the currently generating module.
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

-- | Halts generation and returns the given error message.
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

-- | Constructs a C++ identifier by combining a list of strings with @__@.
makeCppName :: [String] -> String
makeCppName :: [String] -> String
makeCppName = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
cppNameSeparator
  where cppNameSeparator :: String
cppNameSeparator = String
"__"

-- | \"genpop\" is the prefix used for individually exported functions.
externalNamePrefix :: String
externalNamePrefix :: String
externalNamePrefix = String
"genpop"

-- | Returns the C++ binding function name for an external name.
externalNameToCpp :: ExtName -> String
externalNameToCpp :: ExtName -> String
externalNameToCpp ExtName
extName =
  [String] -> String
makeCppName [String
externalNamePrefix, ExtName -> String
fromExtName ExtName
extName]

-- | Returns a distinct argument variable name for each nonnegative number.
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

-- | Same as 'toArgName', but with distinct names, with with similarity between
-- @toArgName n@ and @toArgNameAlt n@.
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
"_"

-- | The C++ variable name to use for the exception ID argument in a gateway
-- function.
exceptionIdArgName :: String
exceptionIdArgName :: String
exceptionIdArgName = String
"excId"

-- | The C++ variable name to use for the exception pointer argument in a
-- gateway function.
exceptionPtrArgName :: String
exceptionPtrArgName :: String
exceptionPtrArgName = String
"excPtr"

-- | The C++ variable name to use in a @catch@ statement in a gateway function.
exceptionVarName :: String
exceptionVarName :: String
exceptionVarName = String
"exc_"

-- | The name of the C++ function that receives an exception from a foreign
-- language and throws it in C++.
exceptionRethrowFnName :: String
exceptionRethrowFnName :: String
exceptionRethrowFnName = String
"genthrow"

-- TODO Fixme, this is most likely backwards, it should be a finite set of
-- non-identifier chars.  Also (maybe) share some logic with the toExtName
-- requirements?
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
"_"

-- | A chunk is a string that contains an arbitrary portion of C++ code,
-- together with a set of includes.  The only requirement is that chunk's code
-- boundaries are also C++ token boundaries, because the generator monad
-- automates the process of inserting whitespace between chunk boundaries where
-- necessary.
data Chunk = Chunk
  { Chunk -> String
chunkContents :: !String
  , Chunk -> Set Include
chunkIncludes :: !(S.Set Include)
  }

-- | Builds a 'Chunk' that contains the given code string.
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
  }

-- | Builds a 'Chunk' that contains the given includes.
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
  }

-- | Runs a 'Chunk' writer, combining them with 'combineChunks' to form a single
-- string.
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

-- | Runs a 'Chunk' writer and returns the monad's value.
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

-- | Runs a 'Chunk' writer and returns the written log.
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

-- | Runs a 'Chunk' writer transformer, combining them with 'combineChunks' to
-- form a single string.
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

-- | Runs a 'Chunk' writer transformer and returns the monad's value.
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

-- | Runs a 'Chunk' writer transformer and returns the written log.
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

-- | Flattens a list of chunks down into a single chunk.  Inserts spaces
-- between chunks where the ends of adjacent chunks would otherwise merge into a
-- single C++ token.  Combines include sets into a single include set.
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 -- "intconstx" should become "int const x"
                     Char -> Bool
isIdentifierChar Char
a Bool -> Bool -> Bool
&& Char -> Bool
isIdentifierChar Char
b Bool -> Bool -> Bool
||
                     -- Adjacent template parameter '>'s need spacing in old C++.
                     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
     }

-- | The section of code that Hoppy is generating, for an export.
data SayExportMode =
    SaySource
    -- ^ Hoppy is generating the C++ source file for a module.  The generator
    -- should emit C++ definitions that will be imported over foreign language's
    -- FFIs.  This is the main place for code generation in C++ bindings.
  | SayHeader
    -- ^ Hoppy is generating the C++ header file for a module.  The generator
    -- should emit C++ declarations that can be @#include@d during the source
    -- file generation of other exportable entities, in order to refer to the
    -- current entity.  If it is not possible for other entities to refer to
    -- this one, then nothing needs to be generated.

-- | Emits a single 'Chunk'.
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

-- | Emits a 'Chunk' for each string in a list.
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

-- | Emits an 'Identifier'.
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
">"

-- | Renders an 'Identifier' to a 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 name maybeParamNames t@ speaks a variable declaration of the form
-- @\<type\> \<name\>@, where @\<name\>@ is the given name, and @\<type\>@ is
-- rendered by giving @maybeParamNames@ and @t@ to 'sayType'.
--
-- This function is useful for generating variable declarations, declarations
-- with assignments, and function prototypes and definitions.
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 maybeParamNames t@ renders @t@ in C++ syntax.  If @t@ is a
-- 'fnT', then @maybeParamNames@ will provide variable names for parameters, if
-- present.
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 ()

-- | Implementation of 'sayType', deals with recursion, precedence, and the
-- inside-out style of C++ type syntax.
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
                 -- TODO ^ Is using the outer stuff correctly here?

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

-- | Renders a C++ function.
sayFunction ::
     String  -- ^ Function name.
  -> [String]  -- ^ Parameter names.
  -> Type  -- ^ Function type.  This should use 'fnT' or 'fnT''.
  -> Maybe (Generator ())
     -- ^ If present, then the function is defined and the action here is used
     -- to render its body.  If absent, then the function is only declared (no
     -- function body).
  -> 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"  -- New top-level structure, leave a blank line.
  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  -- TODO Indent.
      String -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => String -> m ()
say String
"}\n"

-- | Returns a 'Type' iff there is a C type distinct from the given C++ type
-- that should be used for conversion.
--
-- This returns @Nothing@ for 'Internal_TManual'.  TManual needs special
-- handling.
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

-- | Returns the requirements to refer to a type from C++ code.  This is a
-- monadic function so that it has access to the environment, but it does not
-- emit any code.
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 ->
    -- TODO Is the right 'ReqsType' being used recursively here?
    [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

-- | Looks up the module exporting the given external name in the current
-- interface.  'abort' is called if the external name is not found.
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

-- | Combines the given exception handlers (from a particular exported entity)
-- with the handlers from the current module and interface.  The given handlers
-- have highest precedence, followed by module handlers, followed by interface
-- handlers.
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
  -- Exception handlers declared lower in the hierarchy take precedence over
  -- those higher in the hierarchy; ExceptionHandlers is a left-biased monoid.
  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]