{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
module Foreign.Hoppy.Generator.Spec.Base (
ErrorMsg,
Interface,
InterfaceOptions (..),
defaultInterfaceOptions,
interface,
interface',
interfaceName,
interfaceModules,
interfaceNamesToModules,
interfaceHaskellModuleBase,
interfaceDefaultHaskellModuleBase,
interfaceAddHaskellModuleBase,
interfaceHaskellModuleImportNames,
interfaceExceptionHandlers,
interfaceCallbacksThrow,
interfaceSetCallbacksThrow,
interfaceExceptionClassId,
interfaceExceptionSupportModule,
interfaceSetExceptionSupportModule,
interfaceSetSharedPtr,
interfaceCompiler,
interfaceSetCompiler,
interfaceSetCompiler',
interfaceSetNoCompiler,
interfaceValidateEnumTypes,
interfaceSetValidateEnumTypes,
interfaceHooks,
interfaceModifyHooks,
Include,
includeStd,
includeLocal,
includeToString,
Module,
moduleName,
moduleHppPath,
moduleCppPath,
moduleExports,
moduleReqs,
moduleExceptionHandlers,
moduleCallbacksThrow,
moduleSetCallbacksThrow,
moduleAddendum,
moduleHaskellName,
makeModule,
moduleModify,
moduleModify',
moduleSetHppPath,
moduleSetCppPath,
moduleAddExports,
moduleAddHaskellName,
Reqs,
reqsIncludes,
reqInclude,
HasReqs (..),
addReqs,
addReqIncludes,
ExtName,
toExtName,
extNameOrIdentifier,
extNameOrFnIdentifier,
extNameOrString,
isValidExtName,
fromExtName,
HasExtNames (..),
getAllExtNames,
FnName (..),
IsFnName (..),
Operator (..),
OperatorType (..),
operatorPreferredExtName,
operatorPreferredExtName',
operatorType,
Identifier,
makeIdentifier,
identifierParts,
IdPart,
makeIdPart,
idPartBase,
idPartArgs,
ident, ident', ident1, ident2, ident3, ident4, ident5,
identT, identT', ident1T, ident2T, ident3T, ident4T, ident5T,
Exportable (..),
Export (..),
Type (..),
normalizeType,
stripConst,
stripToGc,
Scoped (..),
isScoped,
Constness (..), constNegate,
Purity (..),
Parameter, parameterType, onParameterType, parameterName,
IsParameter (..), toParameters,
np, (~:),
ConversionMethod (..),
ConversionSpec (conversionSpecName, conversionSpecCpp, conversionSpecHaskell),
makeConversionSpec,
ConversionSpecCpp (
ConversionSpecCpp,
conversionSpecCppName,
conversionSpecCppReqs,
conversionSpecCppConversionType,
conversionSpecCppConversionToCppExpr,
conversionSpecCppConversionFromCppExpr
),
makeConversionSpecCpp,
ConversionSpecHaskell (
ConversionSpecHaskell,
conversionSpecHaskellHsType,
conversionSpecHaskellHsArgType,
conversionSpecHaskellCType,
conversionSpecHaskellToCppFn,
conversionSpecHaskellFromCppFn
),
makeConversionSpecHaskell,
ExceptionId (..),
exceptionCatchAllId,
ExceptionHandler (..),
ExceptionHandlers (..),
HandlesExceptions (..),
handleExceptions,
Addendum (..),
HasAddendum (..),
addAddendumHaskell,
EnumInfo (..),
EnumEntryWords,
EnumValueMap (..),
EnumValue (..),
ForeignLanguage (..),
WithForeignLanguageOverrides,
MapWithForeignLanguageOverrides,
HsModuleName, HsImportSet, HsImportKey (..), HsImportSpecs (..), HsImportName, HsImportVal (..),
hsWholeModuleImport, hsQualifiedImport, hsImport1, hsImport1', hsImports, hsImports',
hsImportSetMakeSource,
interfaceAllExceptionClasses,
interfaceSharedPtr,
makeHsImportSet,
getHsImportSet,
hsImportForBits,
hsImportForException,
hsImportForInt,
hsImportForWord,
hsImportForForeign,
hsImportForForeignC,
hsImportForMap,
hsImportForPrelude,
hsImportForRuntime,
hsImportForSystemPosixTypes,
hsImportForUnsafeIO,
objToHeapTWrongDirectionErrorMsg,
tToGcInvalidFormErrorMessage,
toGcTWrongDirectionErrorMsg,
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Arrow ((&&&))
import Control.Monad (liftM2, unless)
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except (MonadError, throwError)
#else
import Control.Monad.Error (MonadError, throwError)
#endif
import Control.Monad.State (MonadState, StateT, execStateT, get, modify, put)
import Data.Char (isAlpha, isAlphaNum)
import Data.Function (on)
import Data.List (intercalate, intersperse)
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid, mappend, mconcat, mempty)
#endif
import Data.Semigroup as Sem
import qualified Data.Set as S
import Data.Typeable (Typeable, cast)
import Foreign.Hoppy.Generator.Common
import Foreign.Hoppy.Generator.Compiler (Compiler, SomeCompiler (SomeCompiler), defaultCompiler)
import {-# SOURCE #-} Foreign.Hoppy.Generator.Hook (Hooks, defaultHooks)
import {-# SOURCE #-} qualified Foreign.Hoppy.Generator.Language.Cpp as LC
import {-# SOURCE #-} qualified Foreign.Hoppy.Generator.Language.Haskell as LH
import Foreign.Hoppy.Generator.Override (MapWithOverrides, WithOverrides)
import {-# SOURCE #-} Foreign.Hoppy.Generator.Spec.Class (Class, classExtName)
import GHC.Stack (HasCallStack)
import Language.Haskell.Syntax (HsName, HsQualType, HsType)
type ErrorMsg = String
data Interface = Interface
{ Interface -> String
interfaceName :: String
, Interface -> Map String Module
interfaceModules :: M.Map String Module
, Interface -> Map ExtName Module
interfaceNamesToModules :: M.Map ExtName Module
, Interface -> Maybe [String]
interfaceHaskellModuleBase' :: Maybe [String]
, Interface -> Map Module String
interfaceHaskellModuleImportNames :: M.Map Module String
, Interface -> ExceptionHandlers
interfaceExceptionHandlers :: ExceptionHandlers
, Interface -> Bool
interfaceCallbacksThrow :: Bool
, Interface -> Map ExtName ExceptionId
interfaceExceptionNamesToIds :: M.Map ExtName ExceptionId
, Interface -> Maybe Module
interfaceExceptionSupportModule :: Maybe Module
, Interface -> (Reqs, String)
interfaceSharedPtr :: (Reqs, String)
, Interface -> Maybe SomeCompiler
interfaceCompiler :: Maybe SomeCompiler
, Interface -> Hooks
interfaceHooks :: Hooks
, Interface -> Bool
interfaceValidateEnumTypes :: Bool
}
instance Show Interface where
show :: Interface -> String
show Interface
iface = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<Interface ", ShowS
forall a. Show a => a -> String
show (Interface -> String
interfaceName Interface
iface), String
">"]
instance HasExports Interface where
lookupExport :: ExtName -> Interface -> Maybe Export
lookupExport ExtName
name Interface
iface =
ExtName -> Module -> Maybe Export
forall a. HasExports a => ExtName -> a -> Maybe Export
lookupExport ExtName
name (Module -> Maybe Export) -> Maybe Module -> Maybe Export
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExtName -> Map ExtName Module -> Maybe Module
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ExtName
name (Interface -> Map ExtName Module
interfaceNamesToModules Interface
iface)
newtype InterfaceOptions = InterfaceOptions
{ InterfaceOptions -> ExceptionHandlers
interfaceOptionsExceptionHandlers :: ExceptionHandlers
}
defaultInterfaceOptions :: InterfaceOptions
defaultInterfaceOptions :: InterfaceOptions
defaultInterfaceOptions = ExceptionHandlers -> InterfaceOptions
InterfaceOptions ExceptionHandlers
forall a. Monoid a => a
mempty
interface :: String
-> [Module]
-> Either ErrorMsg Interface
interface :: String -> [Module] -> Either String Interface
interface String
ifName [Module]
modules = String -> [Module] -> InterfaceOptions -> Either String Interface
interface' String
ifName [Module]
modules InterfaceOptions
defaultInterfaceOptions
interface' :: String
-> [Module]
-> InterfaceOptions
-> Either ErrorMsg Interface
interface' :: String -> [Module] -> InterfaceOptions -> Either String Interface
interface' String
ifName [Module]
modules InterfaceOptions
options = do
let extNamesToModules :: M.Map ExtName [Module]
extNamesToModules :: Map ExtName [Module]
extNamesToModules =
([Module] -> [Module] -> [Module])
-> [Map ExtName [Module]] -> Map ExtName [Module]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
(++) ([Map ExtName [Module]] -> Map ExtName [Module])
-> [Map ExtName [Module]] -> Map ExtName [Module]
forall a b. (a -> b) -> a -> b
$
[Module]
-> (Module -> Map ExtName [Module]) -> [Map ExtName [Module]]
forall a b. [a] -> (a -> b) -> [b]
for [Module]
modules ((Module -> Map ExtName [Module]) -> [Map ExtName [Module]])
-> (Module -> Map ExtName [Module]) -> [Map ExtName [Module]]
forall a b. (a -> b) -> a -> b
$ \Module
m ->
let extNames :: [ExtName]
extNames = (Export -> [ExtName]) -> [Export] -> [ExtName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Export -> [ExtName]
forall a. HasExtNames a => a -> [ExtName]
getAllExtNames ([Export] -> [ExtName]) -> [Export] -> [ExtName]
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
in [(ExtName, [Module])] -> Map ExtName [Module]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ExtName, [Module])] -> Map ExtName [Module])
-> [(ExtName, [Module])] -> Map ExtName [Module]
forall a b. (a -> b) -> a -> b
$ [ExtName] -> [[Module]] -> [(ExtName, [Module])]
forall a b. [a] -> [b] -> [(a, b)]
zip [ExtName]
extNames ([[Module]] -> [(ExtName, [Module])])
-> [[Module]] -> [(ExtName, [Module])]
forall a b. (a -> b) -> a -> b
$ [Module] -> [[Module]]
forall a. a -> [a]
repeat [Module
m]
extNamesInMultipleModules :: [(ExtName, [Module])]
extNamesInMultipleModules :: [(ExtName, [Module])]
extNamesInMultipleModules =
Map ExtName [Module] -> [(ExtName, [Module])]
forall k a. Map k a -> [(k, a)]
M.toList (Map ExtName [Module] -> [(ExtName, [Module])])
-> Map ExtName [Module] -> [(ExtName, [Module])]
forall a b. (a -> b) -> a -> b
$
([Module] -> Bool) -> Map ExtName [Module] -> Map ExtName [Module]
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (\case
Module
_:Module
_:[Module]
_ -> Bool
True
[Module]
_ -> Bool
False)
Map ExtName [Module]
extNamesToModules
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(ExtName, [Module])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ExtName, [Module])]
extNamesInMultipleModules) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
String
"Some external name(s) are exported by multiple modules:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
((ExtName, [Module]) -> String)
-> [(ExtName, [Module])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExtName
extName, [Module]
modules') ->
[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]
forall a. a -> [a] -> [a]
: ExtName -> String
forall a. Show a => a -> String
show ExtName
extName String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
": " String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ((Module -> String) -> [Module] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Module -> String
forall a. Show a => a -> String
show [Module]
modules'))
[(ExtName, [Module])]
extNamesInMultipleModules
let haskellModuleImportNames :: Map Module String
haskellModuleImportNames =
[(Module, String)] -> Map Module String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Module, String)] -> Map Module String)
-> [(Module, String)] -> Map Module String
forall a b. (a -> b) -> a -> b
$
(\[Module]
a [Int]
b Module -> Int -> (Module, String)
f -> (Module -> Int -> (Module, String))
-> [Module] -> [Int] -> [(Module, String)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Module -> Int -> (Module, String)
f [Module]
a [Int]
b) [Module]
modules [(Int
1::Int)..] ((Module -> Int -> (Module, String)) -> [(Module, String)])
-> (Module -> Int -> (Module, String)) -> [(Module, String)]
forall a b. (a -> b) -> a -> b
$
\Module
m Int
index -> (Module
m, Char
'M' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
index)
let exceptionNamesToIds :: Map ExtName ExceptionId
exceptionNamesToIds =
[(ExtName, ExceptionId)] -> Map ExtName ExceptionId
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ExtName, ExceptionId)] -> Map ExtName ExceptionId)
-> [(ExtName, ExceptionId)] -> Map ExtName ExceptionId
forall a b. (a -> b) -> a -> b
$
[ExtName] -> [ExceptionId] -> [(ExtName, ExceptionId)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Class -> ExtName) -> [Class] -> [ExtName]
forall a b. (a -> b) -> [a] -> [b]
map Class -> ExtName
classExtName ([Class] -> [ExtName]) -> [Class] -> [ExtName]
forall a b. (a -> b) -> a -> b
$ [Module] -> [Class]
interfaceAllExceptionClasses' [Module]
modules)
((Int -> ExceptionId) -> [Int] -> [ExceptionId]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ExceptionId
ExceptionId [Int
exceptionFirstFreeId..])
Interface -> Either String Interface
forall (m :: * -> *) a. Monad m => a -> m a
return Interface :: String
-> Map String Module
-> Map ExtName Module
-> Maybe [String]
-> Map Module String
-> ExceptionHandlers
-> Bool
-> Map ExtName ExceptionId
-> Maybe Module
-> (Reqs, String)
-> Maybe SomeCompiler
-> Hooks
-> Bool
-> Interface
Interface
{ interfaceName :: String
interfaceName = String
ifName
, interfaceModules :: Map String Module
interfaceModules = [(String, Module)] -> Map String Module
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Module)] -> Map String Module)
-> [(String, Module)] -> Map String Module
forall a b. (a -> b) -> a -> b
$ (Module -> (String, Module)) -> [Module] -> [(String, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> String
moduleName (Module -> String)
-> (Module -> Module) -> Module -> (String, Module)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Module -> Module
forall a. a -> a
id) [Module]
modules
, interfaceNamesToModules :: Map ExtName Module
interfaceNamesToModules = ([Module] -> Module) -> Map ExtName [Module] -> Map ExtName Module
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\[Module
x] -> Module
x) Map ExtName [Module]
extNamesToModules
, interfaceHaskellModuleBase' :: Maybe [String]
interfaceHaskellModuleBase' = Maybe [String]
forall a. Maybe a
Nothing
, interfaceHaskellModuleImportNames :: Map Module String
interfaceHaskellModuleImportNames = Map Module String
haskellModuleImportNames
, interfaceExceptionHandlers :: ExceptionHandlers
interfaceExceptionHandlers = InterfaceOptions -> ExceptionHandlers
interfaceOptionsExceptionHandlers InterfaceOptions
options
, interfaceCallbacksThrow :: Bool
interfaceCallbacksThrow = Bool
False
, interfaceExceptionNamesToIds :: Map ExtName ExceptionId
interfaceExceptionNamesToIds = Map ExtName ExceptionId
exceptionNamesToIds
, interfaceExceptionSupportModule :: Maybe Module
interfaceExceptionSupportModule = Maybe Module
forall a. Maybe a
Nothing
, interfaceSharedPtr :: (Reqs, String)
interfaceSharedPtr = (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"memory", String
"std::shared_ptr")
, interfaceCompiler :: Maybe SomeCompiler
interfaceCompiler = SomeCompiler -> Maybe SomeCompiler
forall a. a -> Maybe a
Just (SomeCompiler -> Maybe SomeCompiler)
-> SomeCompiler -> Maybe SomeCompiler
forall a b. (a -> b) -> a -> b
$ SimpleCompiler -> SomeCompiler
forall a. Compiler a => a -> SomeCompiler
SomeCompiler SimpleCompiler
defaultCompiler
, interfaceHooks :: Hooks
interfaceHooks = Hooks
defaultHooks
, interfaceValidateEnumTypes :: Bool
interfaceValidateEnumTypes = Bool
True
}
interfaceHaskellModuleBase :: Interface -> [String]
interfaceHaskellModuleBase :: Interface -> [String]
interfaceHaskellModuleBase =
[String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [String]
interfaceDefaultHaskellModuleBase (Maybe [String] -> [String])
-> (Interface -> Maybe [String]) -> Interface -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Maybe [String]
interfaceHaskellModuleBase'
interfaceDefaultHaskellModuleBase :: [String]
interfaceDefaultHaskellModuleBase :: [String]
interfaceDefaultHaskellModuleBase = [String
"Foreign", String
"Hoppy", String
"Generated"]
interfaceAddHaskellModuleBase :: [String] -> Interface -> Either String Interface
interfaceAddHaskellModuleBase :: [String] -> Interface -> Either String Interface
interfaceAddHaskellModuleBase [String]
modulePath Interface
iface = case Interface -> Maybe [String]
interfaceHaskellModuleBase' Interface
iface of
Maybe [String]
Nothing -> Interface -> Either String Interface
forall a b. b -> Either a b
Right Interface
iface { interfaceHaskellModuleBase' :: Maybe [String]
interfaceHaskellModuleBase' = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
modulePath }
Just [String]
existingPath ->
String -> Either String Interface
forall a b. a -> Either a b
Left (String -> Either String Interface)
-> String -> Either String Interface
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"addInterfaceHaskellModuleBase: Trying to add Haskell module base "
, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
modulePath, String
" to ", Interface -> String
forall a. Show a => a -> String
show Interface
iface
, String
" which already has a module base ", String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
existingPath
]
interfaceExceptionClassId :: Interface -> Class -> Maybe ExceptionId
interfaceExceptionClassId :: Interface -> Class -> Maybe ExceptionId
interfaceExceptionClassId Interface
iface Class
cls =
ExtName -> Map ExtName ExceptionId -> Maybe ExceptionId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Class -> ExtName
classExtName Class
cls) (Map ExtName ExceptionId -> Maybe ExceptionId)
-> Map ExtName ExceptionId -> Maybe ExceptionId
forall a b. (a -> b) -> a -> b
$ Interface -> Map ExtName ExceptionId
interfaceExceptionNamesToIds Interface
iface
interfaceAllExceptionClasses :: Interface -> [Class]
interfaceAllExceptionClasses :: Interface -> [Class]
interfaceAllExceptionClasses = [Module] -> [Class]
interfaceAllExceptionClasses' ([Module] -> [Class])
-> (Interface -> [Module]) -> Interface -> [Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String Module -> [Module]
forall k a. Map k a -> [a]
M.elems (Map String Module -> [Module])
-> (Interface -> Map String Module) -> Interface -> [Module]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Map String Module
interfaceModules
interfaceAllExceptionClasses' :: [Module] -> [Class]
interfaceAllExceptionClasses' :: [Module] -> [Class]
interfaceAllExceptionClasses' [Module]
modules =
((Module -> [Class]) -> [Module] -> [Class])
-> [Module] -> (Module -> [Class]) -> [Class]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Module -> [Class]) -> [Module] -> [Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Module]
modules ((Module -> [Class]) -> [Class]) -> (Module -> [Class]) -> [Class]
forall a b. (a -> b) -> a -> b
$ \Module
m ->
[Maybe Class] -> [Class]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Class] -> [Class]) -> [Maybe Class] -> [Class]
forall a b. (a -> b) -> a -> b
$
(Export -> Maybe Class) -> [Export] -> [Maybe Class]
forall a b. (a -> b) -> [a] -> [b]
map Export -> Maybe Class
forall a. Exportable a => a -> Maybe Class
getExportExceptionClass ([Export] -> [Maybe Class]) -> [Export] -> [Maybe Class]
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
interfaceSetCallbacksThrow :: Bool -> Interface -> Interface
interfaceSetCallbacksThrow :: Bool -> Interface -> Interface
interfaceSetCallbacksThrow Bool
b Interface
iface = Interface
iface { interfaceCallbacksThrow :: Bool
interfaceCallbacksThrow = Bool
b }
interfaceSetExceptionSupportModule :: HasCallStack => Module -> Interface -> Interface
interfaceSetExceptionSupportModule :: Module -> Interface -> Interface
interfaceSetExceptionSupportModule Module
m Interface
iface = case Interface -> Maybe Module
interfaceExceptionSupportModule Interface
iface of
Maybe Module
Nothing -> Interface
iface { interfaceExceptionSupportModule :: Maybe Module
interfaceExceptionSupportModule = Module -> Maybe Module
forall a. a -> Maybe a
Just Module
m }
Just Module
existingMod ->
if Module
m Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
existingMod
then Interface
iface
else String -> Interface
forall a. HasCallStack => String -> a
error (String -> Interface) -> String -> Interface
forall a b. (a -> b) -> a -> b
$ String
"interfaceSetExceptionSupportModule: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Interface -> String
forall a. Show a => a -> String
show Interface
iface String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" already has exception support module " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
forall a. Show a => a -> String
show Module
existingMod String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
", trying to set " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
forall a. Show a => a -> String
show Module
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
interfaceSetSharedPtr :: String -> Reqs -> Interface -> Interface
interfaceSetSharedPtr :: String -> Reqs -> Interface -> Interface
interfaceSetSharedPtr String
identifier Reqs
reqs Interface
iface =
Interface
iface { interfaceSharedPtr :: (Reqs, String)
interfaceSharedPtr = (Reqs
reqs, String
identifier) }
interfaceSetCompiler :: Compiler a => a -> Interface -> Interface
interfaceSetCompiler :: a -> Interface -> Interface
interfaceSetCompiler = Maybe SomeCompiler -> Interface -> Interface
interfaceSetCompiler' (Maybe SomeCompiler -> Interface -> Interface)
-> (a -> Maybe SomeCompiler) -> a -> Interface -> Interface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeCompiler -> Maybe SomeCompiler
forall a. a -> Maybe a
Just (SomeCompiler -> Maybe SomeCompiler)
-> (a -> SomeCompiler) -> a -> Maybe SomeCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SomeCompiler
forall a. Compiler a => a -> SomeCompiler
SomeCompiler
interfaceSetCompiler' :: Maybe SomeCompiler -> Interface -> Interface
interfaceSetCompiler' :: Maybe SomeCompiler -> Interface -> Interface
interfaceSetCompiler' Maybe SomeCompiler
compiler Interface
iface = Interface
iface { interfaceCompiler :: Maybe SomeCompiler
interfaceCompiler = Maybe SomeCompiler
compiler }
interfaceSetNoCompiler :: Interface -> Interface
interfaceSetNoCompiler :: Interface -> Interface
interfaceSetNoCompiler =
Bool -> Interface -> Interface
interfaceSetValidateEnumTypes Bool
False (Interface -> Interface)
-> (Interface -> Interface) -> Interface -> Interface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Maybe SomeCompiler -> Interface -> Interface
interfaceSetCompiler' Maybe SomeCompiler
forall a. Maybe a
Nothing
interfaceSetValidateEnumTypes :: Bool -> Interface -> Interface
interfaceSetValidateEnumTypes :: Bool -> Interface -> Interface
interfaceSetValidateEnumTypes Bool
validate Interface
iface =
Interface
iface { interfaceValidateEnumTypes :: Bool
interfaceValidateEnumTypes = Bool
validate }
interfaceModifyHooks :: (Hooks -> Hooks) -> Interface -> Interface
interfaceModifyHooks :: (Hooks -> Hooks) -> Interface -> Interface
interfaceModifyHooks Hooks -> Hooks
f Interface
iface =
Interface
iface { interfaceHooks :: Hooks
interfaceHooks = Hooks -> Hooks
f (Hooks -> Hooks) -> Hooks -> Hooks
forall a b. (a -> b) -> a -> b
$ Interface -> Hooks
interfaceHooks Interface
iface }
newtype Include = Include
{ Include -> String
includeToString :: String
} deriving (Include -> Include -> Bool
(Include -> Include -> Bool)
-> (Include -> Include -> Bool) -> Eq Include
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Include -> Include -> Bool
$c/= :: Include -> Include -> Bool
== :: Include -> Include -> Bool
$c== :: Include -> Include -> Bool
Eq, Eq Include
Eq Include
-> (Include -> Include -> Ordering)
-> (Include -> Include -> Bool)
-> (Include -> Include -> Bool)
-> (Include -> Include -> Bool)
-> (Include -> Include -> Bool)
-> (Include -> Include -> Include)
-> (Include -> Include -> Include)
-> Ord Include
Include -> Include -> Bool
Include -> Include -> Ordering
Include -> Include -> Include
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Include -> Include -> Include
$cmin :: Include -> Include -> Include
max :: Include -> Include -> Include
$cmax :: Include -> Include -> Include
>= :: Include -> Include -> Bool
$c>= :: Include -> Include -> Bool
> :: Include -> Include -> Bool
$c> :: Include -> Include -> Bool
<= :: Include -> Include -> Bool
$c<= :: Include -> Include -> Bool
< :: Include -> Include -> Bool
$c< :: Include -> Include -> Bool
compare :: Include -> Include -> Ordering
$ccompare :: Include -> Include -> Ordering
$cp1Ord :: Eq Include
Ord, Int -> Include -> ShowS
[Include] -> ShowS
Include -> String
(Int -> Include -> ShowS)
-> (Include -> String) -> ([Include] -> ShowS) -> Show Include
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Include] -> ShowS
$cshowList :: [Include] -> ShowS
show :: Include -> String
$cshow :: Include -> String
showsPrec :: Int -> Include -> ShowS
$cshowsPrec :: Int -> Include -> ShowS
Show)
includeStd :: String -> Include
includeStd :: String -> Include
includeStd String
path = String -> Include
Include (String -> Include) -> String -> Include
forall a b. (a -> b) -> a -> b
$ String
"#include <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">\n"
includeLocal :: String -> Include
includeLocal :: String -> Include
includeLocal String
path = String -> Include
Include (String -> Include) -> String -> Include
forall a b. (a -> b) -> a -> b
$ String
"#include \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"\n"
data Module = Module
{ Module -> String
moduleName :: String
, Module -> String
moduleHppPath :: String
, Module -> String
moduleCppPath :: String
, Module -> Map ExtName Export
moduleExports :: M.Map ExtName Export
, Module -> Reqs
moduleReqs :: Reqs
, Module -> Maybe [String]
moduleHaskellName :: Maybe [String]
, Module -> ExceptionHandlers
moduleExceptionHandlers :: ExceptionHandlers
, Module -> Maybe Bool
moduleCallbacksThrow :: Maybe Bool
, Module -> Addendum
moduleAddendum :: Addendum
}
instance Eq Module where
== :: Module -> Module -> Bool
(==) = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (Module -> String) -> Module -> Module -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Module -> String
moduleName
instance Ord Module where
compare :: Module -> Module -> Ordering
compare = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (Module -> String) -> Module -> Module -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Module -> String
moduleName
instance Show Module where
show :: Module -> String
show Module
m = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<Module ", Module -> String
moduleName Module
m, String
">"]
instance HasExports Module where
lookupExport :: ExtName -> Module -> Maybe Export
lookupExport ExtName
name Module
m = ExtName -> Map ExtName Export -> Maybe Export
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ExtName
name (Map ExtName Export -> Maybe Export)
-> Map ExtName Export -> Maybe Export
forall a b. (a -> b) -> a -> b
$ Module -> Map ExtName Export
moduleExports Module
m
instance HasReqs Module where
getReqs :: Module -> Reqs
getReqs = Module -> Reqs
moduleReqs
setReqs :: Reqs -> Module -> Module
setReqs Reqs
reqs Module
m = Module
m { moduleReqs :: Reqs
moduleReqs = Reqs
reqs }
instance HasAddendum Module where
getAddendum :: Module -> Addendum
getAddendum = Module -> Addendum
moduleAddendum
setAddendum :: Addendum -> Module -> Module
setAddendum Addendum
addendum Module
m = Module
m { moduleAddendum :: Addendum
moduleAddendum = Addendum
addendum }
instance HandlesExceptions Module where
getExceptionHandlers :: Module -> ExceptionHandlers
getExceptionHandlers = Module -> ExceptionHandlers
moduleExceptionHandlers
modifyExceptionHandlers :: (ExceptionHandlers -> ExceptionHandlers) -> Module -> Module
modifyExceptionHandlers ExceptionHandlers -> ExceptionHandlers
f Module
m = Module
m { moduleExceptionHandlers :: ExceptionHandlers
moduleExceptionHandlers = ExceptionHandlers -> ExceptionHandlers
f (ExceptionHandlers -> ExceptionHandlers)
-> ExceptionHandlers -> ExceptionHandlers
forall a b. (a -> b) -> a -> b
$ Module -> ExceptionHandlers
moduleExceptionHandlers Module
m }
makeModule :: String
-> String
-> String
-> Module
makeModule :: String -> String -> String -> Module
makeModule String
name String
hppPath String
cppPath = Module :: String
-> String
-> String
-> Map ExtName Export
-> Reqs
-> Maybe [String]
-> ExceptionHandlers
-> Maybe Bool
-> Addendum
-> Module
Module
{ moduleName :: String
moduleName = String
name
, moduleHppPath :: String
moduleHppPath = String
hppPath
, moduleCppPath :: String
moduleCppPath = String
cppPath
, moduleExports :: Map ExtName Export
moduleExports = Map ExtName Export
forall k a. Map k a
M.empty
, moduleReqs :: Reqs
moduleReqs = Reqs
forall a. Monoid a => a
mempty
, moduleHaskellName :: Maybe [String]
moduleHaskellName = Maybe [String]
forall a. Maybe a
Nothing
, moduleExceptionHandlers :: ExceptionHandlers
moduleExceptionHandlers = ExceptionHandlers
forall a. Monoid a => a
mempty
, moduleCallbacksThrow :: Maybe Bool
moduleCallbacksThrow = Maybe Bool
forall a. Maybe a
Nothing
, moduleAddendum :: Addendum
moduleAddendum = Addendum
forall a. Monoid a => a
mempty
}
moduleModify :: Module -> StateT Module (Either String) () -> Either ErrorMsg Module
moduleModify :: Module -> StateT Module (Either String) () -> Either String Module
moduleModify = (StateT Module (Either String) ()
-> Module -> Either String Module)
-> Module
-> StateT Module (Either String) ()
-> Either String Module
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Module (Either String) () -> Module -> Either String Module
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT
moduleModify' :: HasCallStack => Module -> StateT Module (Either String) () -> Module
moduleModify' :: Module -> StateT Module (Either String) () -> Module
moduleModify' Module
m StateT Module (Either String) ()
action = case Module -> StateT Module (Either String) () -> Either String Module
moduleModify Module
m StateT Module (Either String) ()
action of
Left String
errorMsg ->
String -> Module
forall a. HasCallStack => String -> a
error (String -> Module) -> String -> Module
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
"moduleModify' failed to modify ", Module -> String
forall a. Show a => a -> String
show Module
m, String
": ", String
errorMsg]
Right Module
m' -> Module
m'
moduleSetHppPath :: MonadState Module m => String -> m ()
moduleSetHppPath :: String -> m ()
moduleSetHppPath String
path = (Module -> Module) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Module -> Module) -> m ()) -> (Module -> Module) -> m ()
forall a b. (a -> b) -> a -> b
$ \Module
m -> Module
m { moduleHppPath :: String
moduleHppPath = String
path }
moduleSetCppPath :: MonadState Module m => String -> m ()
moduleSetCppPath :: String -> m ()
moduleSetCppPath String
path = (Module -> Module) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Module -> Module) -> m ()) -> (Module -> Module) -> m ()
forall a b. (a -> b) -> a -> b
$ \Module
m -> Module
m { moduleCppPath :: String
moduleCppPath = String
path }
moduleAddExports :: (MonadError String m, MonadState Module m) => [Export] -> m ()
moduleAddExports :: [Export] -> m ()
moduleAddExports [Export]
exports = do
Module
m <- m Module
forall s (m :: * -> *). MonadState s m => m s
get
let existingExports :: Map ExtName Export
existingExports = Module -> Map ExtName Export
moduleExports Module
m
newExports :: Map ExtName Export
newExports = [(ExtName, Export)] -> Map ExtName Export
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ExtName, Export)] -> Map ExtName Export)
-> [(ExtName, Export)] -> Map ExtName Export
forall a b. (a -> b) -> a -> b
$ (Export -> (ExtName, Export)) -> [Export] -> [(ExtName, Export)]
forall a b. (a -> b) -> [a] -> [b]
map (Export -> ExtName
forall a. HasExtNames a => a -> ExtName
getPrimaryExtName (Export -> ExtName)
-> (Export -> Export) -> Export -> (ExtName, Export)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Export -> Export
forall a. a -> a
id) [Export]
exports
duplicateNames :: Set ExtName
duplicateNames = (Set ExtName -> Set ExtName -> Set ExtName
forall a. Ord a => Set a -> Set a -> Set a
S.intersection (Set ExtName -> Set ExtName -> Set ExtName)
-> (Map ExtName Export -> Set ExtName)
-> Map ExtName Export
-> Map ExtName Export
-> Set ExtName
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Map ExtName Export -> Set ExtName
forall k a. Map k a -> Set k
M.keysSet) Map ExtName Export
existingExports Map ExtName Export
newExports
if Set ExtName -> Bool
forall a. Set a -> Bool
S.null Set ExtName
duplicateNames
then Module -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Module
m { moduleExports :: Map ExtName Export
moduleExports = Map ExtName Export
existingExports Map ExtName Export -> Map ExtName Export -> Map ExtName Export
forall a. Monoid a => a -> a -> a
`mappend` Map ExtName Export
newExports }
else String -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
"moduleAddExports: ", Module -> String
forall a. Show a => a -> String
show Module
m, String
" defines external names multiple times: ",
Set ExtName -> String
forall a. Show a => a -> String
show Set ExtName
duplicateNames]
moduleAddHaskellName :: (MonadError String m, MonadState Module m) => [String] -> m ()
moduleAddHaskellName :: [String] -> m ()
moduleAddHaskellName [String]
name = do
Module
m <- m Module
forall s (m :: * -> *). MonadState s m => m s
get
case Module -> Maybe [String]
moduleHaskellName Module
m of
Maybe [String]
Nothing -> Module -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Module
m { moduleHaskellName :: Maybe [String]
moduleHaskellName = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
name }
Just [String]
name' ->
String -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
"moduleAddHaskellName: ", Module -> String
forall a. Show a => a -> String
show Module
m, String
" already has Haskell name ",
[String] -> String
forall a. Show a => a -> String
show [String]
name', String
"; trying to add name ", [String] -> String
forall a. Show a => a -> String
show [String]
name, String
"."]
moduleSetCallbacksThrow :: MonadState Module m => Maybe Bool -> m ()
moduleSetCallbacksThrow :: Maybe Bool -> m ()
moduleSetCallbacksThrow Maybe Bool
b = (Module -> Module) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Module -> Module) -> m ()) -> (Module -> Module) -> m ()
forall a b. (a -> b) -> a -> b
$ \Module
m -> Module
m { moduleCallbacksThrow :: Maybe Bool
moduleCallbacksThrow = Maybe Bool
b }
newtype Reqs = Reqs
{ Reqs -> Set Include
reqsIncludes :: S.Set Include
} deriving (Int -> Reqs -> ShowS
[Reqs] -> ShowS
Reqs -> String
(Int -> Reqs -> ShowS)
-> (Reqs -> String) -> ([Reqs] -> ShowS) -> Show Reqs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reqs] -> ShowS
$cshowList :: [Reqs] -> ShowS
show :: Reqs -> String
$cshow :: Reqs -> String
showsPrec :: Int -> Reqs -> ShowS
$cshowsPrec :: Int -> Reqs -> ShowS
Show)
instance Sem.Semigroup Reqs where
<> :: Reqs -> Reqs -> Reqs
(<>) (Reqs Set Include
incl) (Reqs Set Include
incl') = Set Include -> Reqs
Reqs (Set Include -> Reqs) -> Set Include -> Reqs
forall a b. (a -> b) -> a -> b
$ Set Include -> Set Include -> Set Include
forall a. Monoid a => a -> a -> a
mappend Set Include
incl Set Include
incl'
instance Monoid Reqs where
mempty :: Reqs
mempty = Set Include -> Reqs
Reqs Set Include
forall a. Monoid a => a
mempty
mappend :: Reqs -> Reqs -> Reqs
mappend = Reqs -> Reqs -> Reqs
forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [Reqs] -> Reqs
mconcat [Reqs]
reqs = Set Include -> Reqs
Reqs (Set Include -> Reqs) -> Set Include -> Reqs
forall a b. (a -> b) -> a -> b
$ [Set Include] -> Set Include
forall a. Monoid a => [a] -> a
mconcat ([Set Include] -> Set Include) -> [Set Include] -> Set Include
forall a b. (a -> b) -> a -> b
$ (Reqs -> Set Include) -> [Reqs] -> [Set Include]
forall a b. (a -> b) -> [a] -> [b]
map Reqs -> Set Include
reqsIncludes [Reqs]
reqs
reqInclude :: Include -> Reqs
reqInclude :: Include -> Reqs
reqInclude Include
include = Reqs
forall a. Monoid a => a
mempty { reqsIncludes :: Set Include
reqsIncludes = Include -> Set Include
forall a. a -> Set a
S.singleton Include
include }
class HasReqs a where
{-# MINIMAL getReqs, (setReqs | modifyReqs) #-}
getReqs :: a -> Reqs
setReqs :: Reqs -> a -> a
setReqs = (Reqs -> Reqs) -> a -> a
forall a. HasReqs a => (Reqs -> Reqs) -> a -> a
modifyReqs ((Reqs -> Reqs) -> a -> a)
-> (Reqs -> Reqs -> Reqs) -> Reqs -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reqs -> Reqs -> Reqs
forall a b. a -> b -> a
const
modifyReqs :: (Reqs -> Reqs) -> a -> a
modifyReqs Reqs -> Reqs
f a
x = Reqs -> a -> a
forall a. HasReqs a => Reqs -> a -> a
setReqs (Reqs -> Reqs
f (Reqs -> Reqs) -> Reqs -> Reqs
forall a b. (a -> b) -> a -> b
$ a -> Reqs
forall a. HasReqs a => a -> Reqs
getReqs a
x) a
x
addReqs :: HasReqs a => Reqs -> a -> a
addReqs :: Reqs -> a -> a
addReqs Reqs
reqs = (Reqs -> Reqs) -> a -> a
forall a. HasReqs a => (Reqs -> Reqs) -> a -> a
modifyReqs ((Reqs -> Reqs) -> a -> a) -> (Reqs -> Reqs) -> a -> a
forall a b. (a -> b) -> a -> b
$ Reqs -> Reqs -> Reqs
forall a. Monoid a => a -> a -> a
mappend Reqs
reqs
addReqIncludes :: HasReqs a => [Include] -> a -> a
addReqIncludes :: [Include] -> a -> a
addReqIncludes [Include]
includes =
(Reqs -> Reqs) -> a -> a
forall a. HasReqs a => (Reqs -> Reqs) -> a -> a
modifyReqs ((Reqs -> Reqs) -> a -> a) -> (Reqs -> Reqs) -> a -> a
forall a b. (a -> b) -> a -> b
$ Reqs -> Reqs -> Reqs
forall a. Monoid a => a -> a -> a
mappend Reqs
forall a. Monoid a => a
mempty { reqsIncludes :: Set Include
reqsIncludes = [Include] -> Set Include
forall a. Ord a => [a] -> Set a
S.fromList [Include]
includes }
newtype ExtName = ExtName
{ ExtName -> String
fromExtName :: String
} deriving (ExtName -> ExtName -> Bool
(ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> Bool) -> Eq ExtName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtName -> ExtName -> Bool
$c/= :: ExtName -> ExtName -> Bool
== :: ExtName -> ExtName -> Bool
$c== :: ExtName -> ExtName -> Bool
Eq, b -> ExtName -> ExtName
NonEmpty ExtName -> ExtName
ExtName -> ExtName -> ExtName
(ExtName -> ExtName -> ExtName)
-> (NonEmpty ExtName -> ExtName)
-> (forall b. Integral b => b -> ExtName -> ExtName)
-> Semigroup ExtName
forall b. Integral b => b -> ExtName -> ExtName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> ExtName -> ExtName
$cstimes :: forall b. Integral b => b -> ExtName -> ExtName
sconcat :: NonEmpty ExtName -> ExtName
$csconcat :: NonEmpty ExtName -> ExtName
<> :: ExtName -> ExtName -> ExtName
$c<> :: ExtName -> ExtName -> ExtName
Sem.Semigroup, Semigroup ExtName
ExtName
Semigroup ExtName
-> ExtName
-> (ExtName -> ExtName -> ExtName)
-> ([ExtName] -> ExtName)
-> Monoid ExtName
[ExtName] -> ExtName
ExtName -> ExtName -> ExtName
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ExtName] -> ExtName
$cmconcat :: [ExtName] -> ExtName
mappend :: ExtName -> ExtName -> ExtName
$cmappend :: ExtName -> ExtName -> ExtName
mempty :: ExtName
$cmempty :: ExtName
$cp1Monoid :: Semigroup ExtName
Monoid, Eq ExtName
Eq ExtName
-> (ExtName -> ExtName -> Ordering)
-> (ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> ExtName)
-> (ExtName -> ExtName -> ExtName)
-> Ord ExtName
ExtName -> ExtName -> Bool
ExtName -> ExtName -> Ordering
ExtName -> ExtName -> ExtName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExtName -> ExtName -> ExtName
$cmin :: ExtName -> ExtName -> ExtName
max :: ExtName -> ExtName -> ExtName
$cmax :: ExtName -> ExtName -> ExtName
>= :: ExtName -> ExtName -> Bool
$c>= :: ExtName -> ExtName -> Bool
> :: ExtName -> ExtName -> Bool
$c> :: ExtName -> ExtName -> Bool
<= :: ExtName -> ExtName -> Bool
$c<= :: ExtName -> ExtName -> Bool
< :: ExtName -> ExtName -> Bool
$c< :: ExtName -> ExtName -> Bool
compare :: ExtName -> ExtName -> Ordering
$ccompare :: ExtName -> ExtName -> Ordering
$cp1Ord :: Eq ExtName
Ord)
instance Show ExtName where
show :: ExtName -> String
show ExtName
extName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"$\"", ExtName -> String
fromExtName ExtName
extName, String
"\"$"]
toExtName :: HasCallStack => String -> ExtName
toExtName :: String -> ExtName
toExtName String
str = case String
str of
[] -> String -> ExtName
forall a. HasCallStack => String -> a
error String
"An ExtName cannot be empty."
String
_ -> if String -> Bool
isValidExtName String
str
then String -> ExtName
ExtName String
str
else String -> ExtName
forall a. HasCallStack => String -> a
error (String -> ExtName) -> String -> ExtName
forall a b. (a -> b) -> a -> b
$
String
"An ExtName must start with a letter and only contain letters, numbers, and '_': " String -> ShowS
forall a. [a] -> [a] -> [a]
++
ShowS
forall a. Show a => a -> String
show String
str
isValidExtName :: String -> Bool
isValidExtName :: String -> Bool
isValidExtName String
str = case String
str of
[] -> Bool
False
Char
c:String
cs -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Bool
isAlphaNum (Char -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')) String
cs
extNameOrIdentifier :: HasCallStack => Identifier -> Maybe ExtName -> ExtName
extNameOrIdentifier :: Identifier -> Maybe ExtName -> ExtName
extNameOrIdentifier Identifier
identifier = ExtName -> Maybe ExtName -> ExtName
forall a. a -> Maybe a -> a
fromMaybe (ExtName -> Maybe ExtName -> ExtName)
-> ExtName -> Maybe ExtName -> ExtName
forall a b. (a -> b) -> a -> b
$ case Identifier -> [IdPart]
identifierParts Identifier
identifier of
[] -> String -> ExtName
forall a. HasCallStack => String -> a
error String
"extNameOrIdentifier: Invalid empty identifier."
[IdPart]
parts -> HasCallStack => String -> ExtName
String -> ExtName
toExtName (String -> ExtName) -> String -> ExtName
forall a b. (a -> b) -> a -> b
$ IdPart -> String
idPartBase (IdPart -> String) -> IdPart -> String
forall a b. (a -> b) -> a -> b
$ [IdPart] -> IdPart
forall a. [a] -> a
last [IdPart]
parts
extNameOrFnIdentifier :: HasCallStack => FnName Identifier -> Maybe ExtName -> ExtName
extNameOrFnIdentifier :: FnName Identifier -> Maybe ExtName -> ExtName
extNameOrFnIdentifier FnName Identifier
name =
ExtName -> Maybe ExtName -> ExtName
forall a. a -> Maybe a -> a
fromMaybe (ExtName -> Maybe ExtName -> ExtName)
-> ExtName -> Maybe ExtName -> ExtName
forall a b. (a -> b) -> a -> b
$ case FnName Identifier
name of
FnName Identifier
identifier -> case Identifier -> [IdPart]
identifierParts Identifier
identifier of
[] -> String -> ExtName
forall a. HasCallStack => String -> a
error String
"extNameOrFnIdentifier: Empty idenfitier."
[IdPart]
parts -> HasCallStack => String -> ExtName
String -> ExtName
toExtName (String -> ExtName) -> String -> ExtName
forall a b. (a -> b) -> a -> b
$ IdPart -> String
idPartBase (IdPart -> String) -> IdPart -> String
forall a b. (a -> b) -> a -> b
$ [IdPart] -> IdPart
forall a. [a] -> a
last [IdPart]
parts
FnOp Operator
op -> HasCallStack => Operator -> ExtName
Operator -> ExtName
operatorPreferredExtName Operator
op
extNameOrString :: String -> Maybe ExtName -> ExtName
extNameOrString :: String -> Maybe ExtName -> ExtName
extNameOrString String
str = ExtName -> Maybe ExtName -> ExtName
forall a. a -> Maybe a -> a
fromMaybe (ExtName -> Maybe ExtName -> ExtName)
-> ExtName -> Maybe ExtName -> ExtName
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> ExtName
String -> ExtName
toExtName String
str
class HasExtNames a where
getPrimaryExtName :: a -> ExtName
getNestedExtNames :: a -> [ExtName]
getNestedExtNames a
_ = []
getAllExtNames :: HasExtNames a => a -> [ExtName]
getAllExtNames :: a -> [ExtName]
getAllExtNames a
x = a -> ExtName
forall a. HasExtNames a => a -> ExtName
getPrimaryExtName a
x ExtName -> [ExtName] -> [ExtName]
forall a. a -> [a] -> [a]
: a -> [ExtName]
forall a. HasExtNames a => a -> [ExtName]
getNestedExtNames a
x
data FnName name =
FnName name
| FnOp Operator
deriving (FnName name -> FnName name -> Bool
(FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> Bool) -> Eq (FnName name)
forall name. Eq name => FnName name -> FnName name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FnName name -> FnName name -> Bool
$c/= :: forall name. Eq name => FnName name -> FnName name -> Bool
== :: FnName name -> FnName name -> Bool
$c== :: forall name. Eq name => FnName name -> FnName name -> Bool
Eq, Eq (FnName name)
Eq (FnName name)
-> (FnName name -> FnName name -> Ordering)
-> (FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> FnName name)
-> (FnName name -> FnName name -> FnName name)
-> Ord (FnName name)
FnName name -> FnName name -> Bool
FnName name -> FnName name -> Ordering
FnName name -> FnName name -> FnName name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall name. Ord name => Eq (FnName name)
forall name. Ord name => FnName name -> FnName name -> Bool
forall name. Ord name => FnName name -> FnName name -> Ordering
forall name. Ord name => FnName name -> FnName name -> FnName name
min :: FnName name -> FnName name -> FnName name
$cmin :: forall name. Ord name => FnName name -> FnName name -> FnName name
max :: FnName name -> FnName name -> FnName name
$cmax :: forall name. Ord name => FnName name -> FnName name -> FnName name
>= :: FnName name -> FnName name -> Bool
$c>= :: forall name. Ord name => FnName name -> FnName name -> Bool
> :: FnName name -> FnName name -> Bool
$c> :: forall name. Ord name => FnName name -> FnName name -> Bool
<= :: FnName name -> FnName name -> Bool
$c<= :: forall name. Ord name => FnName name -> FnName name -> Bool
< :: FnName name -> FnName name -> Bool
$c< :: forall name. Ord name => FnName name -> FnName name -> Bool
compare :: FnName name -> FnName name -> Ordering
$ccompare :: forall name. Ord name => FnName name -> FnName name -> Ordering
$cp1Ord :: forall name. Ord name => Eq (FnName name)
Ord)
instance Show name => Show (FnName name) where
show :: FnName name -> String
show (FnName name
name) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<FnName ", name -> String
forall a. Show a => a -> String
show name
name, String
">"]
show (FnOp Operator
op) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<FnOp ", Operator -> String
forall a. Show a => a -> String
show Operator
op, String
">"]
class IsFnName t a where
toFnName :: a -> FnName t
instance IsFnName t (FnName t) where
toFnName :: FnName t -> FnName t
toFnName = FnName t -> FnName t
forall a. a -> a
id
instance IsFnName t t where
toFnName :: t -> FnName t
toFnName = t -> FnName t
forall t. t -> FnName t
FnName
instance IsFnName t Operator where
toFnName :: Operator -> FnName t
toFnName = Operator -> FnName t
forall t. Operator -> FnName t
FnOp
data Operator =
OpCall
| OpComma
| OpAssign
| OpArray
| OpDeref
| OpAddress
| OpAdd
| OpAddAssign
| OpSubtract
| OpSubtractAssign
| OpMultiply
| OpMultiplyAssign
| OpDivide
| OpDivideAssign
| OpModulo
| OpModuloAssign
| OpPlus
| OpMinus
| OpIncPre
| OpIncPost
| OpDecPre
| OpDecPost
| OpEq
| OpNe
| OpLt
| OpLe
| OpGt
| OpGe
| OpNot
| OpAnd
| OpOr
| OpBitNot
| OpBitAnd
| OpBitAndAssign
| OpBitOr
| OpBitOrAssign
| OpBitXor
| OpBitXorAssign
| OpShl
| OpShlAssign
| OpShr
| OpShrAssign
deriving (Operator
Operator -> Operator -> Bounded Operator
forall a. a -> a -> Bounded a
maxBound :: Operator
$cmaxBound :: Operator
minBound :: Operator
$cminBound :: Operator
Bounded, Int -> Operator
Operator -> Int
Operator -> [Operator]
Operator -> Operator
Operator -> Operator -> [Operator]
Operator -> Operator -> Operator -> [Operator]
(Operator -> Operator)
-> (Operator -> Operator)
-> (Int -> Operator)
-> (Operator -> Int)
-> (Operator -> [Operator])
-> (Operator -> Operator -> [Operator])
-> (Operator -> Operator -> [Operator])
-> (Operator -> Operator -> Operator -> [Operator])
-> Enum Operator
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Operator -> Operator -> Operator -> [Operator]
$cenumFromThenTo :: Operator -> Operator -> Operator -> [Operator]
enumFromTo :: Operator -> Operator -> [Operator]
$cenumFromTo :: Operator -> Operator -> [Operator]
enumFromThen :: Operator -> Operator -> [Operator]
$cenumFromThen :: Operator -> Operator -> [Operator]
enumFrom :: Operator -> [Operator]
$cenumFrom :: Operator -> [Operator]
fromEnum :: Operator -> Int
$cfromEnum :: Operator -> Int
toEnum :: Int -> Operator
$ctoEnum :: Int -> Operator
pred :: Operator -> Operator
$cpred :: Operator -> Operator
succ :: Operator -> Operator
$csucc :: Operator -> Operator
Enum, Operator -> Operator -> Bool
(Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool) -> Eq Operator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c== :: Operator -> Operator -> Bool
Eq, Eq Operator
Eq Operator
-> (Operator -> Operator -> Ordering)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Operator)
-> (Operator -> Operator -> Operator)
-> Ord Operator
Operator -> Operator -> Bool
Operator -> Operator -> Ordering
Operator -> Operator -> Operator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Operator -> Operator -> Operator
$cmin :: Operator -> Operator -> Operator
max :: Operator -> Operator -> Operator
$cmax :: Operator -> Operator -> Operator
>= :: Operator -> Operator -> Bool
$c>= :: Operator -> Operator -> Bool
> :: Operator -> Operator -> Bool
$c> :: Operator -> Operator -> Bool
<= :: Operator -> Operator -> Bool
$c<= :: Operator -> Operator -> Bool
< :: Operator -> Operator -> Bool
$c< :: Operator -> Operator -> Bool
compare :: Operator -> Operator -> Ordering
$ccompare :: Operator -> Operator -> Ordering
$cp1Ord :: Eq Operator
Ord, Int -> Operator -> ShowS
[Operator] -> ShowS
Operator -> String
(Int -> Operator -> ShowS)
-> (Operator -> String) -> ([Operator] -> ShowS) -> Show Operator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operator] -> ShowS
$cshowList :: [Operator] -> ShowS
show :: Operator -> String
$cshow :: Operator -> String
showsPrec :: Int -> Operator -> ShowS
$cshowsPrec :: Int -> Operator -> ShowS
Show)
data OperatorType =
UnaryPrefixOperator String
| UnaryPostfixOperator String
| BinaryOperator String
| CallOperator
| ArrayOperator
data OperatorInfo = OperatorInfo
{ OperatorInfo -> ExtName
operatorPreferredExtName'' :: ExtName
, OperatorInfo -> OperatorType
operatorType' :: OperatorType
}
makeOperatorInfo :: String -> OperatorType -> OperatorInfo
makeOperatorInfo :: String -> OperatorType -> OperatorInfo
makeOperatorInfo = ExtName -> OperatorType -> OperatorInfo
OperatorInfo (ExtName -> OperatorType -> OperatorInfo)
-> (String -> ExtName) -> String -> OperatorType -> OperatorInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> ExtName
String -> ExtName
toExtName
operatorPreferredExtName :: HasCallStack => Operator -> ExtName
operatorPreferredExtName :: Operator -> ExtName
operatorPreferredExtName Operator
op = case Operator -> Map Operator OperatorInfo -> Maybe OperatorInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Operator
op Map Operator OperatorInfo
operatorInfo of
Just OperatorInfo
info -> OperatorInfo -> ExtName
operatorPreferredExtName'' OperatorInfo
info
Maybe OperatorInfo
Nothing ->
String -> ExtName
forall a. HasCallStack => String -> a
error (String -> ExtName) -> String -> ExtName
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
"operatorPreferredExtName: Internal error, missing info for operator ", Operator -> String
forall a. Show a => a -> String
show Operator
op, String
"."]
operatorPreferredExtName' :: Operator -> String
operatorPreferredExtName' :: Operator -> String
operatorPreferredExtName' = ExtName -> String
fromExtName (ExtName -> String) -> (Operator -> ExtName) -> Operator -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Operator -> ExtName
Operator -> ExtName
operatorPreferredExtName
operatorType :: HasCallStack => Operator -> OperatorType
operatorType :: Operator -> OperatorType
operatorType Operator
op = case Operator -> Map Operator OperatorInfo -> Maybe OperatorInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Operator
op Map Operator OperatorInfo
operatorInfo of
Just OperatorInfo
info -> OperatorInfo -> OperatorType
operatorType' OperatorInfo
info
Maybe OperatorInfo
Nothing ->
String -> OperatorType
forall a. HasCallStack => String -> a
error (String -> OperatorType) -> String -> OperatorType
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
"operatorType: Internal error, missing info for operator ", Operator -> String
forall a. Show a => a -> String
show Operator
op, String
"."]
operatorInfo :: M.Map Operator OperatorInfo
operatorInfo :: Map Operator OperatorInfo
operatorInfo =
let input :: [(Operator, OperatorInfo)]
input =
[ (Operator
OpCall, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"CALL" OperatorType
CallOperator)
, (Operator
OpComma, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"COMMA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
",")
, (Operator
OpAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"ASSIGN" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"=")
, (Operator
OpArray, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"ARRAY" OperatorType
ArrayOperator)
, (Operator
OpDeref, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"DEREF" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPrefixOperator String
"*")
, (Operator
OpAddress, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"ADDRESS" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPrefixOperator String
"&")
, (Operator
OpAdd, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"ADD" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"+")
, (Operator
OpAddAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"ADDA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"+=")
, (Operator
OpSubtract, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"SUB" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"-")
, (Operator
OpSubtractAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"SUBA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"-=")
, (Operator
OpMultiply, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"MUL" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"*")
, (Operator
OpMultiplyAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"MULA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"*=")
, (Operator
OpDivide, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"DIV" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"/")
, (Operator
OpDivideAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"DIVA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"/=")
, (Operator
OpModulo, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"MOD" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"%")
, (Operator
OpModuloAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"MODA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"%=")
, (Operator
OpPlus, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"PLUS" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPrefixOperator String
"+")
, (Operator
OpMinus, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"NEG" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPrefixOperator String
"-")
, (Operator
OpIncPre, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"INC" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPrefixOperator String
"++")
, (Operator
OpIncPost, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"INCPOST" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPostfixOperator String
"++")
, (Operator
OpDecPre, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"DEC" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPrefixOperator String
"--")
, (Operator
OpDecPost, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"DECPOST" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPostfixOperator String
"--")
, (Operator
OpEq, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"EQ" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"==")
, (Operator
OpNe, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"NE" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"!=")
, (Operator
OpLt, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"LT" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"<")
, (Operator
OpLe, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"LE" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"<=")
, (Operator
OpGt, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"GT" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
">")
, (Operator
OpGe, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"GE" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
">=")
, (Operator
OpNot, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"NOT" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPrefixOperator String
"!")
, (Operator
OpAnd, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"AND" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"&&")
, (Operator
OpOr, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"OR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"||")
, (Operator
OpBitNot, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"BNOT" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
UnaryPrefixOperator String
"~")
, (Operator
OpBitAnd, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"BAND" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"&")
, (Operator
OpBitAndAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"BANDA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"&=")
, (Operator
OpBitOr, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"BOR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"|")
, (Operator
OpBitOrAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"BORA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"|=")
, (Operator
OpBitXor, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"BXOR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"^")
, (Operator
OpBitXorAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"BXORA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"^=")
, (Operator
OpShl, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"SHL" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"<<")
, (Operator
OpShlAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"SHLA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
"<<=")
, (Operator
OpShr, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"SHR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
">>")
, (Operator
OpShrAssign, String -> OperatorType -> OperatorInfo
makeOperatorInfo String
"SHR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ String -> OperatorType
BinaryOperator String
">>=")
]
in if ((Operator, OperatorInfo) -> Operator)
-> [(Operator, OperatorInfo)] -> [Operator]
forall a b. (a -> b) -> [a] -> [b]
map (Operator, OperatorInfo) -> Operator
forall a b. (a, b) -> a
fst [(Operator, OperatorInfo)]
input [Operator] -> [Operator] -> Bool
forall a. Eq a => a -> a -> Bool
== [Operator
forall a. Bounded a => a
minBound..]
then [(Operator, OperatorInfo)] -> Map Operator OperatorInfo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Operator, OperatorInfo)]
input
else String -> Map Operator OperatorInfo
forall a. HasCallStack => String -> a
error String
"operatorInfo: Operator info list is out of sync with Operator data type."
class HasExports a where
lookupExport :: ExtName -> a -> Maybe Export
newtype Identifier = Identifier
{ Identifier -> [IdPart]
identifierParts :: [IdPart]
} deriving (Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c== :: Identifier -> Identifier -> Bool
Eq, Semigroup Identifier
Identifier
Semigroup Identifier
-> Identifier
-> (Identifier -> Identifier -> Identifier)
-> ([Identifier] -> Identifier)
-> Monoid Identifier
[Identifier] -> Identifier
Identifier -> Identifier -> Identifier
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Identifier] -> Identifier
$cmconcat :: [Identifier] -> Identifier
mappend :: Identifier -> Identifier -> Identifier
$cmappend :: Identifier -> Identifier -> Identifier
mempty :: Identifier
$cmempty :: Identifier
$cp1Monoid :: Semigroup Identifier
Monoid, b -> Identifier -> Identifier
NonEmpty Identifier -> Identifier
Identifier -> Identifier -> Identifier
(Identifier -> Identifier -> Identifier)
-> (NonEmpty Identifier -> Identifier)
-> (forall b. Integral b => b -> Identifier -> Identifier)
-> Semigroup Identifier
forall b. Integral b => b -> Identifier -> Identifier
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Identifier -> Identifier
$cstimes :: forall b. Integral b => b -> Identifier -> Identifier
sconcat :: NonEmpty Identifier -> Identifier
$csconcat :: NonEmpty Identifier -> Identifier
<> :: Identifier -> Identifier -> Identifier
$c<> :: Identifier -> Identifier -> Identifier
Sem.Semigroup)
instance Show Identifier where
show :: Identifier -> String
show Identifier
identifier =
(\[String]
wordList -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"<Identifier " String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
wordList [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
">"]) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"::" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
(IdPart -> String) -> [IdPart] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\IdPart
part -> case IdPart -> Maybe [Type]
idPartArgs IdPart
part of
Maybe [Type]
Nothing -> IdPart -> String
idPartBase IdPart
part
Just [Type]
args ->
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
IdPart -> String
idPartBase IdPart
part String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"<" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ((Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Type -> String
forall a. Show a => a -> String
show [Type]
args) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
">"]) ([IdPart] -> [String]) -> [IdPart] -> [String]
forall a b. (a -> b) -> a -> b
$
Identifier -> [IdPart]
identifierParts Identifier
identifier
data IdPart = IdPart
{ IdPart -> String
idPartBase :: String
, IdPart -> Maybe [Type]
idPartArgs :: Maybe [Type]
} deriving (IdPart -> IdPart -> Bool
(IdPart -> IdPart -> Bool)
-> (IdPart -> IdPart -> Bool) -> Eq IdPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdPart -> IdPart -> Bool
$c/= :: IdPart -> IdPart -> Bool
== :: IdPart -> IdPart -> Bool
$c== :: IdPart -> IdPart -> Bool
Eq, Int -> IdPart -> ShowS
[IdPart] -> ShowS
IdPart -> String
(Int -> IdPart -> ShowS)
-> (IdPart -> String) -> ([IdPart] -> ShowS) -> Show IdPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdPart] -> ShowS
$cshowList :: [IdPart] -> ShowS
show :: IdPart -> String
$cshow :: IdPart -> String
showsPrec :: Int -> IdPart -> ShowS
$cshowsPrec :: Int -> IdPart -> ShowS
Show)
makeIdentifier :: [IdPart] -> Identifier
makeIdentifier :: [IdPart] -> Identifier
makeIdentifier = [IdPart] -> Identifier
Identifier
makeIdPart :: String -> Maybe [Type] -> IdPart
makeIdPart :: String -> Maybe [Type] -> IdPart
makeIdPart = String -> Maybe [Type] -> IdPart
IdPart
ident :: String -> Identifier
ident :: String -> Identifier
ident String
a = [IdPart] -> Identifier
Identifier [String -> Maybe [Type] -> IdPart
IdPart String
a Maybe [Type]
forall a. Maybe a
Nothing]
ident' :: [String] -> Identifier
ident' :: [String] -> Identifier
ident' = [IdPart] -> Identifier
Identifier ([IdPart] -> Identifier)
-> ([String] -> [IdPart]) -> [String] -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IdPart) -> [String] -> [IdPart]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> IdPart :: String -> Maybe [Type] -> IdPart
IdPart { idPartBase :: String
idPartBase = String
x, idPartArgs :: Maybe [Type]
idPartArgs = Maybe [Type]
forall a. Maybe a
Nothing })
ident1 :: String -> String -> Identifier
ident1 :: String -> String -> Identifier
ident1 String
a String
b = [String] -> Identifier
ident' [String
a, String
b]
ident2 :: String -> String -> String -> Identifier
ident2 :: String -> String -> String -> Identifier
ident2 String
a String
b String
c = [String] -> Identifier
ident' [String
a, String
b, String
c]
ident3 :: String -> String -> String -> String -> Identifier
ident3 :: String -> String -> String -> String -> Identifier
ident3 String
a String
b String
c String
d = [String] -> Identifier
ident' [String
a, String
b, String
c, String
d]
ident4 :: String -> String -> String -> String -> String -> Identifier
ident4 :: String -> String -> String -> String -> String -> Identifier
ident4 String
a String
b String
c String
d String
e = [String] -> Identifier
ident' [String
a, String
b, String
c, String
d, String
e]
ident5 :: String -> String -> String -> String -> String -> String -> Identifier
ident5 :: String
-> String -> String -> String -> String -> String -> Identifier
ident5 String
a String
b String
c String
d String
e String
f = [String] -> Identifier
ident' [String
a, String
b, String
c, String
d, String
e, String
f]
identT :: String -> [Type] -> Identifier
identT :: String -> [Type] -> Identifier
identT String
a [Type]
ts = [IdPart] -> Identifier
Identifier [String -> Maybe [Type] -> IdPart
IdPart String
a (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]
identT' :: [(String, Maybe [Type])] -> Identifier
identT' :: [(String, Maybe [Type])] -> Identifier
identT' = [IdPart] -> Identifier
Identifier ([IdPart] -> Identifier)
-> ([(String, Maybe [Type])] -> [IdPart])
-> [(String, Maybe [Type])]
-> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Maybe [Type]) -> IdPart)
-> [(String, Maybe [Type])] -> [IdPart]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Maybe [Type] -> IdPart)
-> (String, Maybe [Type]) -> IdPart
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Maybe [Type] -> IdPart
IdPart)
ident1T :: String -> String -> [Type] -> Identifier
ident1T :: String -> String -> [Type] -> Identifier
ident1T String
a String
b [Type]
ts = [IdPart] -> Identifier
Identifier [String -> Maybe [Type] -> IdPart
IdPart String
a Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
b (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]
ident2T :: String -> String -> String -> [Type] -> Identifier
ident2T :: String -> String -> String -> [Type] -> Identifier
ident2T String
a String
b String
c [Type]
ts = [IdPart] -> Identifier
Identifier [String -> Maybe [Type] -> IdPart
IdPart String
a Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
b Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
c (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]
ident3T :: String -> String -> String -> String -> [Type] -> Identifier
ident3T :: String -> String -> String -> String -> [Type] -> Identifier
ident3T String
a String
b String
c String
d [Type]
ts =
[IdPart] -> Identifier
Identifier [String -> Maybe [Type] -> IdPart
IdPart String
a Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
b Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
c Maybe [Type]
forall a. Maybe a
Nothing,
String -> Maybe [Type] -> IdPart
IdPart String
d (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]
ident4T :: String -> String -> String -> String -> String -> [Type] -> Identifier
ident4T :: String
-> String -> String -> String -> String -> [Type] -> Identifier
ident4T String
a String
b String
c String
d String
e [Type]
ts =
[IdPart] -> Identifier
Identifier [String -> Maybe [Type] -> IdPart
IdPart String
a Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
b Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
c Maybe [Type]
forall a. Maybe a
Nothing,
String -> Maybe [Type] -> IdPart
IdPart String
d Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
e (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]
ident5T :: String -> String -> String -> String -> String -> String -> [Type] -> Identifier
ident5T :: String
-> String
-> String
-> String
-> String
-> String
-> [Type]
-> Identifier
ident5T String
a String
b String
c String
d String
e String
f [Type]
ts =
[IdPart] -> Identifier
Identifier [String -> Maybe [Type] -> IdPart
IdPart String
a Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
b Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
c Maybe [Type]
forall a. Maybe a
Nothing,
String -> Maybe [Type] -> IdPart
IdPart String
d Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
e Maybe [Type]
forall a. Maybe a
Nothing, String -> Maybe [Type] -> IdPart
IdPart String
f (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]
class (HasAddendum a, HasExtNames a, HasReqs a, Typeable a, Show a) => Exportable a where
toExport :: a -> Export
toExport = a -> Export
forall a. Exportable a => a -> Export
Export
castExport :: (Typeable a, Exportable b, Typeable b) => a -> Maybe b
castExport = a -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast
sayExportCpp :: LC.SayExportMode -> a -> LC.Generator ()
sayExportHaskell :: LH.SayExportMode -> a -> LH.Generator ()
getExportEnumInfo :: a -> Maybe EnumInfo
getExportEnumInfo a
_ = Maybe EnumInfo
forall a. Maybe a
Nothing
getExportExceptionClass :: a -> Maybe Class
getExportExceptionClass a
_ = Maybe Class
forall a. Maybe a
Nothing
data Export = forall a. Exportable a => Export a
instance HasAddendum Export where
getAddendum :: Export -> Addendum
getAddendum (Export a
e) = a -> Addendum
forall a. HasAddendum a => a -> Addendum
getAddendum a
e
setAddendum :: Addendum -> Export -> Export
setAddendum Addendum
a (Export a
e) = a -> Export
forall a. Exportable a => a -> Export
Export (a -> Export) -> a -> Export
forall a b. (a -> b) -> a -> b
$ Addendum -> a -> a
forall a. HasAddendum a => Addendum -> a -> a
setAddendum Addendum
a a
e
modifyAddendum :: (Addendum -> Addendum) -> Export -> Export
modifyAddendum Addendum -> Addendum
f (Export a
e) = a -> Export
forall a. Exportable a => a -> Export
Export (a -> Export) -> a -> Export
forall a b. (a -> b) -> a -> b
$ (Addendum -> Addendum) -> a -> a
forall a. HasAddendum a => (Addendum -> Addendum) -> a -> a
modifyAddendum Addendum -> Addendum
f a
e
instance HasExtNames Export where
getPrimaryExtName :: Export -> ExtName
getPrimaryExtName (Export a
e) = a -> ExtName
forall a. HasExtNames a => a -> ExtName
getPrimaryExtName a
e
getNestedExtNames :: Export -> [ExtName]
getNestedExtNames (Export a
e) = a -> [ExtName]
forall a. HasExtNames a => a -> [ExtName]
getNestedExtNames a
e
instance HasReqs Export where
getReqs :: Export -> Reqs
getReqs (Export a
e) = a -> Reqs
forall a. HasReqs a => a -> Reqs
getReqs a
e
setReqs :: Reqs -> Export -> Export
setReqs Reqs
reqs (Export a
e) = a -> Export
forall a. Exportable a => a -> Export
Export (a -> Export) -> a -> Export
forall a b. (a -> b) -> a -> b
$ Reqs -> a -> a
forall a. HasReqs a => Reqs -> a -> a
setReqs Reqs
reqs a
e
modifyReqs :: (Reqs -> Reqs) -> Export -> Export
modifyReqs Reqs -> Reqs
f (Export a
e) = a -> Export
forall a. Exportable a => a -> Export
Export (a -> Export) -> a -> Export
forall a b. (a -> b) -> a -> b
$ (Reqs -> Reqs) -> a -> a
forall a. HasReqs a => (Reqs -> Reqs) -> a -> a
modifyReqs Reqs -> Reqs
f a
e
instance Exportable Export where
toExport :: Export -> Export
toExport = Export -> Export
forall a. a -> a
id
castExport :: Export -> Maybe b
castExport (Export a
e) = a -> Maybe b
forall a b.
(Exportable a, Typeable a, Exportable b, Typeable b) =>
a -> Maybe b
castExport a
e
sayExportCpp :: SayExportMode -> Export -> Generator ()
sayExportCpp SayExportMode
sayBody (Export a
e) = SayExportMode -> a -> Generator ()
forall a. Exportable a => SayExportMode -> a -> Generator ()
sayExportCpp SayExportMode
sayBody a
e
sayExportHaskell :: SayExportMode -> Export -> Generator ()
sayExportHaskell SayExportMode
mode (Export a
e) = SayExportMode -> a -> Generator ()
forall a. Exportable a => SayExportMode -> a -> Generator ()
sayExportHaskell SayExportMode
mode a
e
getExportEnumInfo :: Export -> Maybe EnumInfo
getExportEnumInfo (Export a
e) = a -> Maybe EnumInfo
forall a. Exportable a => a -> Maybe EnumInfo
getExportEnumInfo a
e
getExportExceptionClass :: Export -> Maybe Class
getExportExceptionClass (Export a
e) = a -> Maybe Class
forall a. Exportable a => a -> Maybe Class
getExportExceptionClass a
e
instance Show Export where
show :: Export -> String
show (Export a
e) = String
"<Export " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
data Type =
Internal_TVoid
| Internal_TPtr Type
| Internal_TRef Type
| Internal_TFn [Parameter] Type
| Internal_TObj Class
| Internal_TObjToHeap Class
| Internal_TToGc Type
| Internal_TManual ConversionSpec
| Internal_TConst Type
deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)
instance Eq Type where
Type
Internal_TVoid == :: Type -> Type -> Bool
== Type
Internal_TVoid = Bool
True
(Internal_TPtr Type
t) == (Internal_TPtr Type
t') = Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t'
(Internal_TRef Type
t) == (Internal_TRef Type
t') = Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t'
(Internal_TFn [Parameter]
ps Type
r) == (Internal_TFn [Parameter]
ps' Type
r') =
([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Parameter -> Parameter -> Bool)
-> [Parameter] -> [Parameter] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Type -> Type -> Bool)
-> (Parameter -> Type) -> Parameter -> Parameter -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Parameter -> Type
parameterType) [Parameter]
ps [Parameter]
ps') Bool -> Bool -> Bool
&& Type
r Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
r'
(Internal_TObj Class
cls) == (Internal_TObj Class
cls') = Class
cls Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
cls'
(Internal_TObjToHeap Class
cls) == (Internal_TObjToHeap Class
cls') = Class
cls Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
cls'
(Internal_TToGc Type
t) == (Internal_TToGc Type
t') = Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t'
(Internal_TManual ConversionSpec
s) == (Internal_TManual ConversionSpec
s') = ConversionSpec
s ConversionSpec -> ConversionSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ConversionSpec
s'
(Internal_TConst Type
t) == (Internal_TConst Type
t') = Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t'
Type
_ == Type
_ = Bool
False
normalizeType :: Type -> Type
normalizeType :: Type -> Type
normalizeType Type
t = case Type
t of
Type
Internal_TVoid -> Type
t
Internal_TPtr Type
t' -> Type -> Type
Internal_TPtr (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
normalizeType Type
t'
Internal_TRef Type
t' -> Type -> Type
Internal_TRef (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
normalizeType Type
t'
Internal_TFn [Parameter]
params Type
retType ->
[Parameter] -> Type -> Type
Internal_TFn ((Parameter -> Parameter) -> [Parameter] -> [Parameter]
forall a b. (a -> b) -> [a] -> [b]
map ((Type -> Type) -> Parameter -> Parameter
onParameterType Type -> Type
normalizeType) [Parameter]
params) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
normalizeType Type
retType
Internal_TObj Class
_ -> Type
t
Internal_TObjToHeap Class
_ -> Type
t
Internal_TToGc Type
_ -> Type
t
Internal_TManual ConversionSpec
_ -> Type
t
Internal_TConst (Internal_TConst Type
t') -> Type -> Type
normalizeType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
Internal_TConst Type
t'
Internal_TConst Type
_ -> Type
t
stripConst :: Type -> Type
stripConst :: Type -> Type
stripConst Type
t = case Type
t of
Internal_TConst Type
t' -> Type -> Type
stripConst Type
t'
Type
_ -> Type
t
stripToGc :: Type -> Type
stripToGc :: Type -> Type
stripToGc Type
t = case Type
t of
Internal_TToGc Type
t' -> Type
t'
Type
_ -> Type
t
data Scoped =
Unscoped
| Scoped
deriving (Scoped -> Scoped -> Bool
(Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Bool) -> Eq Scoped
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scoped -> Scoped -> Bool
$c/= :: Scoped -> Scoped -> Bool
== :: Scoped -> Scoped -> Bool
$c== :: Scoped -> Scoped -> Bool
Eq, Eq Scoped
Eq Scoped
-> (Scoped -> Scoped -> Ordering)
-> (Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Scoped)
-> (Scoped -> Scoped -> Scoped)
-> Ord Scoped
Scoped -> Scoped -> Bool
Scoped -> Scoped -> Ordering
Scoped -> Scoped -> Scoped
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Scoped -> Scoped -> Scoped
$cmin :: Scoped -> Scoped -> Scoped
max :: Scoped -> Scoped -> Scoped
$cmax :: Scoped -> Scoped -> Scoped
>= :: Scoped -> Scoped -> Bool
$c>= :: Scoped -> Scoped -> Bool
> :: Scoped -> Scoped -> Bool
$c> :: Scoped -> Scoped -> Bool
<= :: Scoped -> Scoped -> Bool
$c<= :: Scoped -> Scoped -> Bool
< :: Scoped -> Scoped -> Bool
$c< :: Scoped -> Scoped -> Bool
compare :: Scoped -> Scoped -> Ordering
$ccompare :: Scoped -> Scoped -> Ordering
$cp1Ord :: Eq Scoped
Ord, Int -> Scoped -> ShowS
[Scoped] -> ShowS
Scoped -> String
(Int -> Scoped -> ShowS)
-> (Scoped -> String) -> ([Scoped] -> ShowS) -> Show Scoped
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scoped] -> ShowS
$cshowList :: [Scoped] -> ShowS
show :: Scoped -> String
$cshow :: Scoped -> String
showsPrec :: Int -> Scoped -> ShowS
$cshowsPrec :: Int -> Scoped -> ShowS
Show)
isScoped :: Scoped -> Bool
isScoped :: Scoped -> Bool
isScoped Scoped
Unscoped = Bool
False
isScoped Scoped
Scoped = Bool
True
data Constness = Nonconst | Const
deriving (Constness
Constness -> Constness -> Bounded Constness
forall a. a -> a -> Bounded a
maxBound :: Constness
$cmaxBound :: Constness
minBound :: Constness
$cminBound :: Constness
Bounded, Int -> Constness
Constness -> Int
Constness -> [Constness]
Constness -> Constness
Constness -> Constness -> [Constness]
Constness -> Constness -> Constness -> [Constness]
(Constness -> Constness)
-> (Constness -> Constness)
-> (Int -> Constness)
-> (Constness -> Int)
-> (Constness -> [Constness])
-> (Constness -> Constness -> [Constness])
-> (Constness -> Constness -> [Constness])
-> (Constness -> Constness -> Constness -> [Constness])
-> Enum Constness
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Constness -> Constness -> Constness -> [Constness]
$cenumFromThenTo :: Constness -> Constness -> Constness -> [Constness]
enumFromTo :: Constness -> Constness -> [Constness]
$cenumFromTo :: Constness -> Constness -> [Constness]
enumFromThen :: Constness -> Constness -> [Constness]
$cenumFromThen :: Constness -> Constness -> [Constness]
enumFrom :: Constness -> [Constness]
$cenumFrom :: Constness -> [Constness]
fromEnum :: Constness -> Int
$cfromEnum :: Constness -> Int
toEnum :: Int -> Constness
$ctoEnum :: Int -> Constness
pred :: Constness -> Constness
$cpred :: Constness -> Constness
succ :: Constness -> Constness
$csucc :: Constness -> Constness
Enum, Constness -> Constness -> Bool
(Constness -> Constness -> Bool)
-> (Constness -> Constness -> Bool) -> Eq Constness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constness -> Constness -> Bool
$c/= :: Constness -> Constness -> Bool
== :: Constness -> Constness -> Bool
$c== :: Constness -> Constness -> Bool
Eq, Int -> Constness -> ShowS
[Constness] -> ShowS
Constness -> String
(Int -> Constness -> ShowS)
-> (Constness -> String)
-> ([Constness] -> ShowS)
-> Show Constness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constness] -> ShowS
$cshowList :: [Constness] -> ShowS
show :: Constness -> String
$cshow :: Constness -> String
showsPrec :: Int -> Constness -> ShowS
$cshowsPrec :: Int -> Constness -> ShowS
Show)
constNegate :: Constness -> Constness
constNegate :: Constness -> Constness
constNegate Constness
Nonconst = Constness
Const
constNegate Constness
Const = Constness
Nonconst
data Purity = Nonpure
| Pure
deriving (Purity -> Purity -> Bool
(Purity -> Purity -> Bool)
-> (Purity -> Purity -> Bool) -> Eq Purity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Purity -> Purity -> Bool
$c/= :: Purity -> Purity -> Bool
== :: Purity -> Purity -> Bool
$c== :: Purity -> Purity -> Bool
Eq, Int -> Purity -> ShowS
[Purity] -> ShowS
Purity -> String
(Int -> Purity -> ShowS)
-> (Purity -> String) -> ([Purity] -> ShowS) -> Show Purity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Purity] -> ShowS
$cshowList :: [Purity] -> ShowS
show :: Purity -> String
$cshow :: Purity -> String
showsPrec :: Int -> Purity -> ShowS
$cshowsPrec :: Int -> Purity -> ShowS
Show)
data Parameter = Parameter
{ Parameter -> Type
parameterType :: Type
, Parameter -> Maybe String
parameterName :: Maybe String
} deriving (Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> String
(Int -> Parameter -> ShowS)
-> (Parameter -> String)
-> ([Parameter] -> ShowS)
-> Show Parameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameter] -> ShowS
$cshowList :: [Parameter] -> ShowS
show :: Parameter -> String
$cshow :: Parameter -> String
showsPrec :: Int -> Parameter -> ShowS
$cshowsPrec :: Int -> Parameter -> ShowS
Show)
class Show a => IsParameter a where
toParameter :: a -> Parameter
instance IsParameter Parameter where
toParameter :: Parameter -> Parameter
toParameter = Parameter -> Parameter
forall a. a -> a
id
instance IsParameter Type where
toParameter :: Type -> Parameter
toParameter Type
t =
Parameter :: Type -> Maybe String -> Parameter
Parameter
{ parameterType :: Type
parameterType = Type
t
, parameterName :: Maybe String
parameterName = Maybe String
forall a. Maybe a
Nothing
}
onParameterType :: (Type -> Type) -> (Parameter -> Parameter)
onParameterType :: (Type -> Type) -> Parameter -> Parameter
onParameterType Type -> Type
f Parameter
p = Parameter
p { parameterType :: Type
parameterType = Type -> Type
f (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Parameter -> Type
parameterType Parameter
p }
np :: [Parameter]
np :: [Parameter]
np = []
toParameters :: IsParameter a => [a] -> [Parameter]
toParameters :: [a] -> [Parameter]
toParameters = (a -> Parameter) -> [a] -> [Parameter]
forall a b. (a -> b) -> [a] -> [b]
map a -> Parameter
forall a. IsParameter a => a -> Parameter
toParameter
(~:) :: IsParameter a => String -> a -> Parameter
~: :: String -> a -> Parameter
(~:) String
name a
param =
(a -> Parameter
forall a. IsParameter a => a -> Parameter
toParameter a
param) { parameterName :: Maybe String
parameterName = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
name }
infixr 0 ~:
data ConversionMethod c =
ConversionUnsupported
| BinaryCompatible
| CustomConversion c
deriving (Int -> ConversionMethod c -> ShowS
[ConversionMethod c] -> ShowS
ConversionMethod c -> String
(Int -> ConversionMethod c -> ShowS)
-> (ConversionMethod c -> String)
-> ([ConversionMethod c] -> ShowS)
-> Show (ConversionMethod c)
forall c. Show c => Int -> ConversionMethod c -> ShowS
forall c. Show c => [ConversionMethod c] -> ShowS
forall c. Show c => ConversionMethod c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConversionMethod c] -> ShowS
$cshowList :: forall c. Show c => [ConversionMethod c] -> ShowS
show :: ConversionMethod c -> String
$cshow :: forall c. Show c => ConversionMethod c -> String
showsPrec :: Int -> ConversionMethod c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> ConversionMethod c -> ShowS
Show)
data ConversionSpec = ConversionSpec
{ ConversionSpec -> String
conversionSpecName :: String
, ConversionSpec -> ConversionSpecCpp
conversionSpecCpp :: ConversionSpecCpp
, ConversionSpec -> Maybe ConversionSpecHaskell
conversionSpecHaskell :: Maybe ConversionSpecHaskell
}
instance Eq ConversionSpec where
== :: ConversionSpec -> ConversionSpec -> Bool
(==) = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (ConversionSpec -> String)
-> ConversionSpec
-> ConversionSpec
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ConversionSpec -> String
conversionSpecName
instance Show ConversionSpec where
show :: ConversionSpec -> String
show ConversionSpec
x = String
"<ConversionSpec " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (ConversionSpec -> String
conversionSpecName ConversionSpec
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
makeConversionSpec ::
String
-> ConversionSpecCpp
-> ConversionSpec
makeConversionSpec :: String -> ConversionSpecCpp -> ConversionSpec
makeConversionSpec String
name ConversionSpecCpp
cppSpec =
ConversionSpec :: String
-> ConversionSpecCpp
-> Maybe ConversionSpecHaskell
-> ConversionSpec
ConversionSpec
{ conversionSpecName :: String
conversionSpecName = String
name
, conversionSpecCpp :: ConversionSpecCpp
conversionSpecCpp = ConversionSpecCpp
cppSpec
, conversionSpecHaskell :: Maybe ConversionSpecHaskell
conversionSpecHaskell = Maybe ConversionSpecHaskell
forall a. Maybe a
Nothing
}
data ConversionSpecCpp = ConversionSpecCpp
{ ConversionSpecCpp -> String
conversionSpecCppName :: String
, ConversionSpecCpp -> Generator Reqs
conversionSpecCppReqs :: LC.Generator Reqs
, ConversionSpecCpp -> Generator (Maybe Type)
conversionSpecCppConversionType :: LC.Generator (Maybe Type)
, ConversionSpecCpp
-> Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
conversionSpecCppConversionToCppExpr ::
Maybe (LC.Generator () -> Maybe (LC.Generator ()) -> LC.Generator ())
, ConversionSpecCpp
-> Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
conversionSpecCppConversionFromCppExpr ::
Maybe (LC.Generator () -> Maybe (LC.Generator ()) -> LC.Generator ())
}
makeConversionSpecCpp :: String -> LC.Generator Reqs -> ConversionSpecCpp
makeConversionSpecCpp :: String -> Generator Reqs -> ConversionSpecCpp
makeConversionSpecCpp String
cppName Generator Reqs
cppReqs =
ConversionSpecCpp :: String
-> Generator Reqs
-> Generator (Maybe Type)
-> Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
-> Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
-> ConversionSpecCpp
ConversionSpecCpp
{ conversionSpecCppName :: String
conversionSpecCppName = String
cppName
, conversionSpecCppReqs :: Generator Reqs
conversionSpecCppReqs = Generator Reqs
cppReqs
, conversionSpecCppConversionType :: Generator (Maybe Type)
conversionSpecCppConversionType = Maybe Type -> Generator (Maybe Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Type
forall a. Maybe a
Nothing
, conversionSpecCppConversionToCppExpr :: Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
conversionSpecCppConversionToCppExpr = Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
forall a. Maybe a
Nothing
, conversionSpecCppConversionFromCppExpr :: Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
conversionSpecCppConversionFromCppExpr = Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
forall a. Maybe a
Nothing
}
data ConversionSpecHaskell = ConversionSpecHaskell
{ ConversionSpecHaskell -> Generator HsType
conversionSpecHaskellHsType :: LH.Generator HsType
, ConversionSpecHaskell -> Maybe (HsName -> Generator HsQualType)
conversionSpecHaskellHsArgType :: Maybe (HsName -> LH.Generator HsQualType)
, ConversionSpecHaskell -> Maybe (Generator HsType)
conversionSpecHaskellCType :: Maybe (LH.Generator HsType)
, ConversionSpecHaskell -> ConversionMethod (Generator ())
conversionSpecHaskellToCppFn :: ConversionMethod (LH.Generator ())
, ConversionSpecHaskell -> ConversionMethod (Generator ())
conversionSpecHaskellFromCppFn :: ConversionMethod (LH.Generator ())
}
makeConversionSpecHaskell ::
LH.Generator HsType
-> Maybe (LH.Generator HsType)
-> ConversionMethod (LH.Generator ())
-> ConversionMethod (LH.Generator ())
-> ConversionSpecHaskell
makeConversionSpecHaskell :: Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> ConversionSpecHaskell
makeConversionSpecHaskell Generator HsType
hsType Maybe (Generator HsType)
cType ConversionMethod (Generator ())
toCppFn ConversionMethod (Generator ())
fromCppFn =
ConversionSpecHaskell :: Generator HsType
-> Maybe (HsName -> Generator HsQualType)
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> ConversionSpecHaskell
ConversionSpecHaskell
{ conversionSpecHaskellHsType :: Generator HsType
conversionSpecHaskellHsType = Generator HsType
hsType
, conversionSpecHaskellHsArgType :: Maybe (HsName -> Generator HsQualType)
conversionSpecHaskellHsArgType = Maybe (HsName -> Generator HsQualType)
forall a. Maybe a
Nothing
, conversionSpecHaskellCType :: Maybe (Generator HsType)
conversionSpecHaskellCType = Maybe (Generator HsType)
cType
, conversionSpecHaskellToCppFn :: ConversionMethod (Generator ())
conversionSpecHaskellToCppFn = ConversionMethod (Generator ())
toCppFn
, conversionSpecHaskellFromCppFn :: ConversionMethod (Generator ())
conversionSpecHaskellFromCppFn = ConversionMethod (Generator ())
fromCppFn
}
newtype ExceptionId = ExceptionId
{ ExceptionId -> Int
getExceptionId :: Int
} deriving (ExceptionId -> ExceptionId -> Bool
(ExceptionId -> ExceptionId -> Bool)
-> (ExceptionId -> ExceptionId -> Bool) -> Eq ExceptionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExceptionId -> ExceptionId -> Bool
$c/= :: ExceptionId -> ExceptionId -> Bool
== :: ExceptionId -> ExceptionId -> Bool
$c== :: ExceptionId -> ExceptionId -> Bool
Eq, Int -> ExceptionId -> ShowS
[ExceptionId] -> ShowS
ExceptionId -> String
(Int -> ExceptionId -> ShowS)
-> (ExceptionId -> String)
-> ([ExceptionId] -> ShowS)
-> Show ExceptionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExceptionId] -> ShowS
$cshowList :: [ExceptionId] -> ShowS
show :: ExceptionId -> String
$cshow :: ExceptionId -> String
showsPrec :: Int -> ExceptionId -> ShowS
$cshowsPrec :: Int -> ExceptionId -> ShowS
Show)
exceptionCatchAllId :: ExceptionId
exceptionCatchAllId :: ExceptionId
exceptionCatchAllId = Int -> ExceptionId
ExceptionId Int
1
exceptionFirstFreeId :: Int
exceptionFirstFreeId :: Int
exceptionFirstFreeId = ExceptionId -> Int
getExceptionId ExceptionId
exceptionCatchAllId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
data ExceptionHandler =
CatchClass Class
| CatchAll
deriving (ExceptionHandler -> ExceptionHandler -> Bool
(ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> Eq ExceptionHandler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExceptionHandler -> ExceptionHandler -> Bool
$c/= :: ExceptionHandler -> ExceptionHandler -> Bool
== :: ExceptionHandler -> ExceptionHandler -> Bool
$c== :: ExceptionHandler -> ExceptionHandler -> Bool
Eq, Eq ExceptionHandler
Eq ExceptionHandler
-> (ExceptionHandler -> ExceptionHandler -> Ordering)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> ExceptionHandler)
-> (ExceptionHandler -> ExceptionHandler -> ExceptionHandler)
-> Ord ExceptionHandler
ExceptionHandler -> ExceptionHandler -> Bool
ExceptionHandler -> ExceptionHandler -> Ordering
ExceptionHandler -> ExceptionHandler -> ExceptionHandler
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExceptionHandler -> ExceptionHandler -> ExceptionHandler
$cmin :: ExceptionHandler -> ExceptionHandler -> ExceptionHandler
max :: ExceptionHandler -> ExceptionHandler -> ExceptionHandler
$cmax :: ExceptionHandler -> ExceptionHandler -> ExceptionHandler
>= :: ExceptionHandler -> ExceptionHandler -> Bool
$c>= :: ExceptionHandler -> ExceptionHandler -> Bool
> :: ExceptionHandler -> ExceptionHandler -> Bool
$c> :: ExceptionHandler -> ExceptionHandler -> Bool
<= :: ExceptionHandler -> ExceptionHandler -> Bool
$c<= :: ExceptionHandler -> ExceptionHandler -> Bool
< :: ExceptionHandler -> ExceptionHandler -> Bool
$c< :: ExceptionHandler -> ExceptionHandler -> Bool
compare :: ExceptionHandler -> ExceptionHandler -> Ordering
$ccompare :: ExceptionHandler -> ExceptionHandler -> Ordering
$cp1Ord :: Eq ExceptionHandler
Ord)
newtype ExceptionHandlers = ExceptionHandlers
{ ExceptionHandlers -> [ExceptionHandler]
exceptionHandlersList :: [ExceptionHandler]
}
instance Sem.Semigroup ExceptionHandlers where
<> :: ExceptionHandlers -> ExceptionHandlers -> ExceptionHandlers
(<>) ExceptionHandlers
e1 ExceptionHandlers
e2 =
[ExceptionHandler] -> ExceptionHandlers
ExceptionHandlers ([ExceptionHandler] -> ExceptionHandlers)
-> [ExceptionHandler] -> ExceptionHandlers
forall a b. (a -> b) -> a -> b
$ ExceptionHandlers -> [ExceptionHandler]
exceptionHandlersList ExceptionHandlers
e1 [ExceptionHandler] -> [ExceptionHandler] -> [ExceptionHandler]
forall a. [a] -> [a] -> [a]
++ ExceptionHandlers -> [ExceptionHandler]
exceptionHandlersList ExceptionHandlers
e2
instance Monoid ExceptionHandlers where
mempty :: ExceptionHandlers
mempty = [ExceptionHandler] -> ExceptionHandlers
ExceptionHandlers []
mappend :: ExceptionHandlers -> ExceptionHandlers -> ExceptionHandlers
mappend = ExceptionHandlers -> ExceptionHandlers -> ExceptionHandlers
forall a. Semigroup a => a -> a -> a
(<>)
class HandlesExceptions a where
getExceptionHandlers :: a -> ExceptionHandlers
modifyExceptionHandlers :: (ExceptionHandlers -> ExceptionHandlers) -> a -> a
handleExceptions :: HandlesExceptions a => [ExceptionHandler] -> a -> a
handleExceptions :: [ExceptionHandler] -> a -> a
handleExceptions [ExceptionHandler]
classes =
(ExceptionHandlers -> ExceptionHandlers) -> a -> a
forall a.
HandlesExceptions a =>
(ExceptionHandlers -> ExceptionHandlers) -> a -> a
modifyExceptionHandlers ((ExceptionHandlers -> ExceptionHandlers) -> a -> a)
-> (ExceptionHandlers -> ExceptionHandlers) -> a -> a
forall a b. (a -> b) -> a -> b
$ ExceptionHandlers -> ExceptionHandlers -> ExceptionHandlers
forall a. Monoid a => a -> a -> a
mappend ExceptionHandlers
forall a. Monoid a => a
mempty { exceptionHandlersList :: [ExceptionHandler]
exceptionHandlersList = [ExceptionHandler]
classes }
newtype Addendum = Addendum
{ Addendum -> Generator ()
addendumHaskell :: LH.Generator ()
}
instance Sem.Semigroup Addendum where
<> :: Addendum -> Addendum -> Addendum
(<>) (Addendum Generator ()
a) (Addendum Generator ()
b) = Generator () -> Addendum
Addendum (Generator () -> Addendum) -> Generator () -> Addendum
forall a b. (a -> b) -> a -> b
$ Generator ()
a Generator () -> Generator () -> Generator ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Generator ()
b
instance Monoid Addendum where
mempty :: Addendum
mempty = Generator () -> Addendum
Addendum (Generator () -> Addendum) -> Generator () -> Addendum
forall a b. (a -> b) -> a -> b
$ () -> Generator ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mappend :: Addendum -> Addendum -> Addendum
mappend = Addendum -> Addendum -> Addendum
forall a. Semigroup a => a -> a -> a
(<>)
class HasAddendum a where
{-# MINIMAL getAddendum, (setAddendum | modifyAddendum) #-}
getAddendum :: a -> Addendum
setAddendum :: Addendum -> a -> a
setAddendum Addendum
addendum = (Addendum -> Addendum) -> a -> a
forall a. HasAddendum a => (Addendum -> Addendum) -> a -> a
modifyAddendum ((Addendum -> Addendum) -> a -> a)
-> (Addendum -> Addendum) -> a -> a
forall a b. (a -> b) -> a -> b
$ Addendum -> Addendum -> Addendum
forall a b. a -> b -> a
const Addendum
addendum
modifyAddendum :: (Addendum -> Addendum) -> a -> a
modifyAddendum Addendum -> Addendum
f a
x = Addendum -> a -> a
forall a. HasAddendum a => Addendum -> a -> a
setAddendum (Addendum -> Addendum
f (Addendum -> Addendum) -> Addendum -> Addendum
forall a b. (a -> b) -> a -> b
$ a -> Addendum
forall a. HasAddendum a => a -> Addendum
getAddendum a
x) a
x
addAddendumHaskell :: HasAddendum a => LH.Generator () -> a -> a
addAddendumHaskell :: Generator () -> a -> a
addAddendumHaskell Generator ()
gen = (Addendum -> Addendum) -> a -> a
forall a. HasAddendum a => (Addendum -> Addendum) -> a -> a
modifyAddendum ((Addendum -> Addendum) -> a -> a)
-> (Addendum -> Addendum) -> a -> a
forall a b. (a -> b) -> a -> b
$ \Addendum
addendum ->
Addendum
addendum Addendum -> Addendum -> Addendum
forall a. Monoid a => a -> a -> a
`mappend` Addendum
forall a. Monoid a => a
mempty { addendumHaskell :: Generator ()
addendumHaskell = Generator ()
gen }
data EnumInfo = EnumInfo
{ EnumInfo -> ExtName
enumInfoExtName :: ExtName
, EnumInfo -> Identifier
enumInfoIdentifier :: Identifier
, EnumInfo -> Maybe Type
enumInfoNumericType :: Maybe Type
, EnumInfo -> Reqs
enumInfoReqs :: Reqs
, EnumInfo -> Scoped
enumInfoScoped :: Scoped
, EnumInfo -> EnumValueMap
enumInfoValues :: EnumValueMap
}
type EnumEntryWords = [String]
data EnumValueMap = EnumValueMap
{ EnumValueMap -> [[String]]
enumValueMapNames :: [EnumEntryWords]
, EnumValueMap -> MapWithForeignLanguageOverrides [String] [String]
enumValueMapForeignNames :: MapWithForeignLanguageOverrides EnumEntryWords EnumEntryWords
, EnumValueMap -> Map [String] EnumValue
enumValueMapValues :: M.Map EnumEntryWords EnumValue
}
instance Eq EnumValueMap where
== :: EnumValueMap -> EnumValueMap -> Bool
(==) = Map [String] EnumValue -> Map [String] EnumValue -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Map [String] EnumValue -> Map [String] EnumValue -> Bool)
-> (EnumValueMap -> Map [String] EnumValue)
-> EnumValueMap
-> EnumValueMap
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` EnumValueMap -> Map [String] EnumValue
enumValueMapValues
instance Show EnumValueMap where
show :: EnumValueMap -> String
show EnumValueMap
x = String
"<EnumValueMap values=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map [String] EnumValue -> String
forall a. Show a => a -> String
show (EnumValueMap -> Map [String] EnumValue
enumValueMapValues EnumValueMap
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
data EnumValue =
EnumValueManual Integer
| EnumValueAuto Identifier
deriving (EnumValue -> EnumValue -> Bool
(EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool) -> Eq EnumValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumValue -> EnumValue -> Bool
$c/= :: EnumValue -> EnumValue -> Bool
== :: EnumValue -> EnumValue -> Bool
$c== :: EnumValue -> EnumValue -> Bool
Eq, Int -> EnumValue -> ShowS
[EnumValue] -> ShowS
EnumValue -> String
(Int -> EnumValue -> ShowS)
-> (EnumValue -> String)
-> ([EnumValue] -> ShowS)
-> Show EnumValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumValue] -> ShowS
$cshowList :: [EnumValue] -> ShowS
show :: EnumValue -> String
$cshow :: EnumValue -> String
showsPrec :: Int -> EnumValue -> ShowS
$cshowsPrec :: Int -> EnumValue -> ShowS
Show)
data ForeignLanguage =
Haskell
deriving (ForeignLanguage -> ForeignLanguage -> Bool
(ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> Eq ForeignLanguage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignLanguage -> ForeignLanguage -> Bool
$c/= :: ForeignLanguage -> ForeignLanguage -> Bool
== :: ForeignLanguage -> ForeignLanguage -> Bool
$c== :: ForeignLanguage -> ForeignLanguage -> Bool
Eq, Eq ForeignLanguage
Eq ForeignLanguage
-> (ForeignLanguage -> ForeignLanguage -> Ordering)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> ForeignLanguage)
-> (ForeignLanguage -> ForeignLanguage -> ForeignLanguage)
-> Ord ForeignLanguage
ForeignLanguage -> ForeignLanguage -> Bool
ForeignLanguage -> ForeignLanguage -> Ordering
ForeignLanguage -> ForeignLanguage -> ForeignLanguage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ForeignLanguage -> ForeignLanguage -> ForeignLanguage
$cmin :: ForeignLanguage -> ForeignLanguage -> ForeignLanguage
max :: ForeignLanguage -> ForeignLanguage -> ForeignLanguage
$cmax :: ForeignLanguage -> ForeignLanguage -> ForeignLanguage
>= :: ForeignLanguage -> ForeignLanguage -> Bool
$c>= :: ForeignLanguage -> ForeignLanguage -> Bool
> :: ForeignLanguage -> ForeignLanguage -> Bool
$c> :: ForeignLanguage -> ForeignLanguage -> Bool
<= :: ForeignLanguage -> ForeignLanguage -> Bool
$c<= :: ForeignLanguage -> ForeignLanguage -> Bool
< :: ForeignLanguage -> ForeignLanguage -> Bool
$c< :: ForeignLanguage -> ForeignLanguage -> Bool
compare :: ForeignLanguage -> ForeignLanguage -> Ordering
$ccompare :: ForeignLanguage -> ForeignLanguage -> Ordering
$cp1Ord :: Eq ForeignLanguage
Ord, Int -> ForeignLanguage -> ShowS
[ForeignLanguage] -> ShowS
ForeignLanguage -> String
(Int -> ForeignLanguage -> ShowS)
-> (ForeignLanguage -> String)
-> ([ForeignLanguage] -> ShowS)
-> Show ForeignLanguage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignLanguage] -> ShowS
$cshowList :: [ForeignLanguage] -> ShowS
show :: ForeignLanguage -> String
$cshow :: ForeignLanguage -> String
showsPrec :: Int -> ForeignLanguage -> ShowS
$cshowsPrec :: Int -> ForeignLanguage -> ShowS
Show)
type WithForeignLanguageOverrides = WithOverrides ForeignLanguage
type MapWithForeignLanguageOverrides = MapWithOverrides ForeignLanguage
data HsImportSet = HsImportSet
{ HsImportSet -> Map HsImportKey HsImportSpecs
getHsImportSet :: M.Map HsImportKey HsImportSpecs
} deriving (Int -> HsImportSet -> ShowS
[HsImportSet] -> ShowS
HsImportSet -> String
(Int -> HsImportSet -> ShowS)
-> (HsImportSet -> String)
-> ([HsImportSet] -> ShowS)
-> Show HsImportSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsImportSet] -> ShowS
$cshowList :: [HsImportSet] -> ShowS
show :: HsImportSet -> String
$cshow :: HsImportSet -> String
showsPrec :: Int -> HsImportSet -> ShowS
$cshowsPrec :: Int -> HsImportSet -> ShowS
Show)
instance Sem.Semigroup HsImportSet where
<> :: HsImportSet -> HsImportSet -> HsImportSet
(<>) (HsImportSet Map HsImportKey HsImportSpecs
m) (HsImportSet Map HsImportKey HsImportSpecs
m') =
Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ (HsImportSpecs -> HsImportSpecs -> HsImportSpecs)
-> Map HsImportKey HsImportSpecs
-> Map HsImportKey HsImportSpecs
-> Map HsImportKey HsImportSpecs
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith HsImportSpecs -> HsImportSpecs -> HsImportSpecs
mergeImportSpecs Map HsImportKey HsImportSpecs
m Map HsImportKey HsImportSpecs
m'
instance Monoid HsImportSet where
mempty :: HsImportSet
mempty = Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet Map HsImportKey HsImportSpecs
forall k a. Map k a
M.empty
mappend :: HsImportSet -> HsImportSet -> HsImportSet
mappend = HsImportSet -> HsImportSet -> HsImportSet
forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [HsImportSet] -> HsImportSet
mconcat [HsImportSet]
sets =
Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ (HsImportSpecs -> HsImportSpecs -> HsImportSpecs)
-> [Map HsImportKey HsImportSpecs] -> Map HsImportKey HsImportSpecs
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith HsImportSpecs -> HsImportSpecs -> HsImportSpecs
mergeImportSpecs ([Map HsImportKey HsImportSpecs] -> Map HsImportKey HsImportSpecs)
-> [Map HsImportKey HsImportSpecs] -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$ (HsImportSet -> Map HsImportKey HsImportSpecs)
-> [HsImportSet] -> [Map HsImportKey HsImportSpecs]
forall a b. (a -> b) -> [a] -> [b]
map HsImportSet -> Map HsImportKey HsImportSpecs
getHsImportSet [HsImportSet]
sets
makeHsImportSet :: M.Map HsImportKey HsImportSpecs -> HsImportSet
makeHsImportSet :: Map HsImportKey HsImportSpecs -> HsImportSet
makeHsImportSet = Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet
hsImportSetMakeSource :: HsImportSet -> HsImportSet
hsImportSetMakeSource :: HsImportSet -> HsImportSet
hsImportSetMakeSource (HsImportSet Map HsImportKey HsImportSpecs
m) =
Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ (HsImportSpecs -> HsImportSpecs)
-> Map HsImportKey HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\HsImportSpecs
specs -> HsImportSpecs
specs { hsImportSource :: Bool
hsImportSource = Bool
True }) Map HsImportKey HsImportSpecs
m
type HsModuleName = String
data HsImportKey = HsImportKey
{ HsImportKey -> String
hsImportModule :: HsModuleName
, HsImportKey -> Maybe String
hsImportQualifiedName :: Maybe HsModuleName
} deriving (HsImportKey -> HsImportKey -> Bool
(HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> Bool) -> Eq HsImportKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HsImportKey -> HsImportKey -> Bool
$c/= :: HsImportKey -> HsImportKey -> Bool
== :: HsImportKey -> HsImportKey -> Bool
$c== :: HsImportKey -> HsImportKey -> Bool
Eq, Eq HsImportKey
Eq HsImportKey
-> (HsImportKey -> HsImportKey -> Ordering)
-> (HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> HsImportKey)
-> (HsImportKey -> HsImportKey -> HsImportKey)
-> Ord HsImportKey
HsImportKey -> HsImportKey -> Bool
HsImportKey -> HsImportKey -> Ordering
HsImportKey -> HsImportKey -> HsImportKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HsImportKey -> HsImportKey -> HsImportKey
$cmin :: HsImportKey -> HsImportKey -> HsImportKey
max :: HsImportKey -> HsImportKey -> HsImportKey
$cmax :: HsImportKey -> HsImportKey -> HsImportKey
>= :: HsImportKey -> HsImportKey -> Bool
$c>= :: HsImportKey -> HsImportKey -> Bool
> :: HsImportKey -> HsImportKey -> Bool
$c> :: HsImportKey -> HsImportKey -> Bool
<= :: HsImportKey -> HsImportKey -> Bool
$c<= :: HsImportKey -> HsImportKey -> Bool
< :: HsImportKey -> HsImportKey -> Bool
$c< :: HsImportKey -> HsImportKey -> Bool
compare :: HsImportKey -> HsImportKey -> Ordering
$ccompare :: HsImportKey -> HsImportKey -> Ordering
$cp1Ord :: Eq HsImportKey
Ord, Int -> HsImportKey -> ShowS
[HsImportKey] -> ShowS
HsImportKey -> String
(Int -> HsImportKey -> ShowS)
-> (HsImportKey -> String)
-> ([HsImportKey] -> ShowS)
-> Show HsImportKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsImportKey] -> ShowS
$cshowList :: [HsImportKey] -> ShowS
show :: HsImportKey -> String
$cshow :: HsImportKey -> String
showsPrec :: Int -> HsImportKey -> ShowS
$cshowsPrec :: Int -> HsImportKey -> ShowS
Show)
data HsImportSpecs = HsImportSpecs
{ HsImportSpecs -> Maybe (Map String HsImportVal)
getHsImportSpecs :: Maybe (M.Map HsImportName HsImportVal)
, HsImportSpecs -> Bool
hsImportSource :: Bool
} deriving (Int -> HsImportSpecs -> ShowS
[HsImportSpecs] -> ShowS
HsImportSpecs -> String
(Int -> HsImportSpecs -> ShowS)
-> (HsImportSpecs -> String)
-> ([HsImportSpecs] -> ShowS)
-> Show HsImportSpecs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsImportSpecs] -> ShowS
$cshowList :: [HsImportSpecs] -> ShowS
show :: HsImportSpecs -> String
$cshow :: HsImportSpecs -> String
showsPrec :: Int -> HsImportSpecs -> ShowS
$cshowsPrec :: Int -> HsImportSpecs -> ShowS
Show)
mergeImportSpecs :: HsImportSpecs -> HsImportSpecs -> HsImportSpecs
mergeImportSpecs :: HsImportSpecs -> HsImportSpecs -> HsImportSpecs
mergeImportSpecs (HsImportSpecs Maybe (Map String HsImportVal)
mm Bool
s) (HsImportSpecs Maybe (Map String HsImportVal)
mm' Bool
s') =
Maybe (Map String HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs ((Map String HsImportVal
-> Map String HsImportVal -> Map String HsImportVal)
-> Maybe (Map String HsImportVal)
-> Maybe (Map String HsImportVal)
-> Maybe (Map String HsImportVal)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Map String HsImportVal
-> Map String HsImportVal -> Map String HsImportVal
mergeMaps Maybe (Map String HsImportVal)
mm Maybe (Map String HsImportVal)
mm') (Bool
s Bool -> Bool -> Bool
|| Bool
s')
where mergeMaps :: Map String HsImportVal
-> Map String HsImportVal -> Map String HsImportVal
mergeMaps = (HsImportVal -> HsImportVal -> HsImportVal)
-> Map String HsImportVal
-> Map String HsImportVal
-> Map String HsImportVal
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith HsImportVal -> HsImportVal -> HsImportVal
mergeValues
mergeValues :: HsImportVal -> HsImportVal -> HsImportVal
mergeValues HsImportVal
v HsImportVal
v' = case (HsImportVal
v, HsImportVal
v') of
(HsImportVal
HsImportValAll, HsImportVal
_) -> HsImportVal
HsImportValAll
(HsImportVal
_, HsImportVal
HsImportValAll) -> HsImportVal
HsImportValAll
(HsImportValSome [String]
x, HsImportValSome [String]
x') -> [String] -> HsImportVal
HsImportValSome ([String] -> HsImportVal) -> [String] -> HsImportVal
forall a b. (a -> b) -> a -> b
$ [String]
x [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
x'
(x :: HsImportVal
x@(HsImportValSome [String]
_), HsImportVal
_) -> HsImportVal
x
(HsImportVal
_, x :: HsImportVal
x@(HsImportValSome [String]
_)) -> HsImportVal
x
(HsImportVal
HsImportVal, HsImportVal
HsImportVal) -> HsImportVal
HsImportVal
type HsImportName = String
data HsImportVal =
HsImportVal
| HsImportValSome [HsImportName]
| HsImportValAll
deriving (Int -> HsImportVal -> ShowS
[HsImportVal] -> ShowS
HsImportVal -> String
(Int -> HsImportVal -> ShowS)
-> (HsImportVal -> String)
-> ([HsImportVal] -> ShowS)
-> Show HsImportVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsImportVal] -> ShowS
$cshowList :: [HsImportVal] -> ShowS
show :: HsImportVal -> String
$cshow :: HsImportVal -> String
showsPrec :: Int -> HsImportVal -> ShowS
$cshowsPrec :: Int -> HsImportVal -> ShowS
Show)
hsWholeModuleImport :: HsModuleName -> HsImportSet
hsWholeModuleImport :: String -> HsImportSet
hsWholeModuleImport String
modName =
Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ HsImportKey -> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall k a. k -> a -> Map k a
M.singleton (String -> Maybe String -> HsImportKey
HsImportKey String
modName Maybe String
forall a. Maybe a
Nothing) (HsImportSpecs -> Map HsImportKey HsImportSpecs)
-> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$
Maybe (Map String HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs Maybe (Map String HsImportVal)
forall a. Maybe a
Nothing Bool
False
hsQualifiedImport :: HsModuleName -> HsModuleName -> HsImportSet
hsQualifiedImport :: String -> String -> HsImportSet
hsQualifiedImport String
modName String
qualifiedName =
Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ HsImportKey -> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall k a. k -> a -> Map k a
M.singleton (String -> Maybe String -> HsImportKey
HsImportKey String
modName (Maybe String -> HsImportKey) -> Maybe String -> HsImportKey
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
qualifiedName) (HsImportSpecs -> Map HsImportKey HsImportSpecs)
-> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$
Maybe (Map String HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs Maybe (Map String HsImportVal)
forall a. Maybe a
Nothing Bool
False
hsImport1 :: HsModuleName -> HsImportName -> HsImportSet
hsImport1 :: String -> String -> HsImportSet
hsImport1 String
modName String
valueName = String -> String -> HsImportVal -> HsImportSet
hsImport1' String
modName String
valueName HsImportVal
HsImportVal
hsImport1' :: HsModuleName -> HsImportName -> HsImportVal -> HsImportSet
hsImport1' :: String -> String -> HsImportVal -> HsImportSet
hsImport1' String
modName String
valueName HsImportVal
valueType =
Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ HsImportKey -> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall k a. k -> a -> Map k a
M.singleton (String -> Maybe String -> HsImportKey
HsImportKey String
modName Maybe String
forall a. Maybe a
Nothing) (HsImportSpecs -> Map HsImportKey HsImportSpecs)
-> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$
Maybe (Map String HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs (Map String HsImportVal -> Maybe (Map String HsImportVal)
forall a. a -> Maybe a
Just (Map String HsImportVal -> Maybe (Map String HsImportVal))
-> Map String HsImportVal -> Maybe (Map String HsImportVal)
forall a b. (a -> b) -> a -> b
$ String -> HsImportVal -> Map String HsImportVal
forall k a. k -> a -> Map k a
M.singleton String
valueName HsImportVal
valueType) Bool
False
hsImports :: HsModuleName -> [HsImportName] -> HsImportSet
hsImports :: String -> [String] -> HsImportSet
hsImports String
modName [String]
names =
String -> [(String, HsImportVal)] -> HsImportSet
hsImports' String
modName ([(String, HsImportVal)] -> HsImportSet)
-> [(String, HsImportVal)] -> HsImportSet
forall a b. (a -> b) -> a -> b
$ (String -> (String, HsImportVal))
-> [String] -> [(String, HsImportVal)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
name -> (String
name, HsImportVal
HsImportVal)) [String]
names
hsImports' :: HsModuleName -> [(HsImportName, HsImportVal)] -> HsImportSet
hsImports' :: String -> [(String, HsImportVal)] -> HsImportSet
hsImports' String
modName [(String, HsImportVal)]
values =
Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ HsImportKey -> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall k a. k -> a -> Map k a
M.singleton (String -> Maybe String -> HsImportKey
HsImportKey String
modName Maybe String
forall a. Maybe a
Nothing) (HsImportSpecs -> Map HsImportKey HsImportSpecs)
-> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$
Maybe (Map String HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs (Map String HsImportVal -> Maybe (Map String HsImportVal)
forall a. a -> Maybe a
Just (Map String HsImportVal -> Maybe (Map String HsImportVal))
-> Map String HsImportVal -> Maybe (Map String HsImportVal)
forall a b. (a -> b) -> a -> b
$ [(String, HsImportVal)] -> Map String HsImportVal
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, HsImportVal)]
values) Bool
False
hsImportForBits :: HsImportSet
hsImportForBits :: HsImportSet
hsImportForBits = String -> String -> HsImportSet
hsQualifiedImport String
"Data.Bits" String
"HoppyDB"
hsImportForException :: HsImportSet
hsImportForException :: HsImportSet
hsImportForException = String -> String -> HsImportSet
hsQualifiedImport String
"Control.Exception" String
"HoppyCE"
hsImportForInt :: HsImportSet
hsImportForInt :: HsImportSet
hsImportForInt = String -> String -> HsImportSet
hsQualifiedImport String
"Data.Int" String
"HoppyDI"
hsImportForWord :: HsImportSet
hsImportForWord :: HsImportSet
hsImportForWord = String -> String -> HsImportSet
hsQualifiedImport String
"Data.Word" String
"HoppyDW"
hsImportForForeign :: HsImportSet
hsImportForForeign :: HsImportSet
hsImportForForeign = String -> String -> HsImportSet
hsQualifiedImport String
"Foreign" String
"HoppyF"
hsImportForForeignC :: HsImportSet
hsImportForForeignC :: HsImportSet
hsImportForForeignC = String -> String -> HsImportSet
hsQualifiedImport String
"Foreign.C" String
"HoppyFC"
hsImportForMap :: HsImportSet
hsImportForMap :: HsImportSet
hsImportForMap = String -> String -> HsImportSet
hsQualifiedImport String
"Data.Map" String
"HoppyDM"
hsImportForPrelude :: HsImportSet
hsImportForPrelude :: HsImportSet
hsImportForPrelude = String -> String -> HsImportSet
hsQualifiedImport String
"Prelude" String
"HoppyP"
hsImportForRuntime :: HsImportSet
hsImportForRuntime :: HsImportSet
hsImportForRuntime = String -> String -> HsImportSet
hsQualifiedImport String
"Foreign.Hoppy.Runtime" String
"HoppyFHR"
hsImportForSystemPosixTypes :: HsImportSet
hsImportForSystemPosixTypes :: HsImportSet
hsImportForSystemPosixTypes = String -> String -> HsImportSet
hsQualifiedImport String
"System.Posix.Types" String
"HoppySPT"
hsImportForUnsafeIO :: HsImportSet
hsImportForUnsafeIO :: HsImportSet
hsImportForUnsafeIO = String -> String -> HsImportSet
hsQualifiedImport String
"System.IO.Unsafe" String
"HoppySIU"
objToHeapTWrongDirectionErrorMsg :: Maybe String -> Class -> String
objToHeapTWrongDirectionErrorMsg :: Maybe String -> Class -> String
objToHeapTWrongDirectionErrorMsg Maybe String
maybeCaller Class
cls =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ") Maybe String
maybeCaller,
String
"(TObjToHeap ", Class -> String
forall a. Show a => a -> String
show Class
cls, String
") cannot be passed into C++",
String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> ShowS
forall a b. a -> b -> a
const String
".") Maybe String
maybeCaller]
tToGcInvalidFormErrorMessage :: Maybe String -> Type -> String
tToGcInvalidFormErrorMessage :: Maybe String -> Type -> String
tToGcInvalidFormErrorMessage Maybe String
maybeCaller Type
typeArg =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ") Maybe String
maybeCaller,
String
"(", Type -> String
forall a. Show a => a -> String
show (Type -> Type
Internal_TToGc Type
typeArg), String
") is an invalid form for TToGc.",
String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> ShowS
forall a b. a -> b -> a
const String
".") Maybe String
maybeCaller]
toGcTWrongDirectionErrorMsg :: Maybe String -> Type -> String
toGcTWrongDirectionErrorMsg :: Maybe String -> Type -> String
toGcTWrongDirectionErrorMsg Maybe String
maybeCaller Type
typeArg =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ") Maybe String
maybeCaller,
String
"(", Type -> String
forall a. Show a => a -> String
show (Type -> Type
Internal_TToGc Type
typeArg), String
") cannot be passed into C++",
String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> ShowS
forall a b. a -> b -> a
const String
".") Maybe String
maybeCaller]