%
%
%
Specifying type / marshalling information
\begin{code}
module TypeInfo
( TypeInfo(..)
, typeInfos
, v_bool_ti
, variant_ti
, mb_currency_ti
, mb_date_ti
, guid_ti
, iid_ti
, clsid_ti
, bstr_ti
) where
import BasicTypes
import NativeInfo
import Opts
import Maybe
import AbsHUtils
import AbstractH ( Type )
import LibUtils ( comLib )
\end{code}
A @TypeInfo@ record contains all the info needed by the
backend(s) to convert the use of a type into appropriate
Haskell code.
\begin{code}
data TypeInfo
= TypeInfo {
type_name :: String,
haskell_type :: QualName,
marshaller :: QualName,
copy_marshaller :: QualName,
unmarshaller :: QualName,
ref_marshaller :: QualName,
ref_unmarshaller :: QualName,
alloc_type :: Maybe QualName,
free_type :: Maybe QualName,
prim_type :: Type,
c_type :: String,
prim_size :: QualName,
prim_sizeof :: Int,
prim_align :: Int,
auto_type :: QualName,
is_pointed :: Bool,
finalised :: Bool,
attributes :: Maybe String
}
deriving ( Show, Eq )
\end{code}
\begin{code}
typeInfos :: [TypeInfo]
typeInfos =
[ variant_ti
, v_bool_ti
, currency_ti
, iid_ti
, clsid_ti
, guid_ti
]
iid_ti :: TypeInfo
iid_ti =
TypeInfo
{ type_name = "IID"
, haskell_type = toQualName "Com.IID a"
, marshaller = toQualName "Com.marshallIID"
, copy_marshaller = toQualName "Com.copyIID"
, unmarshaller = toQualName "Com.unmarshallIID"
, ref_marshaller = toQualName "Com.writeIID"
, ref_unmarshaller = toQualName "Com.readIID"
, alloc_type = Nothing
, free_type = Nothing
, prim_type = tyForeignPtr (tyQCon comLib "IID" [uniqueTyVar "a"])
, c_type = "IID*"
, auto_type = toQualName "Com.IID a"
, prim_size = toQualName "Com.sizeofIID"
, prim_sizeof = 16
, prim_align = 4
, is_pointed = True
, finalised = True
, attributes = Nothing
}
clsid_ti :: TypeInfo
clsid_ti =
TypeInfo
{ type_name = "CLSID"
, haskell_type = toQualName "Com.CLSID"
, marshaller = toQualName "Com.marshallCLSID"
, copy_marshaller = toQualName "Com.copyCLSID"
, unmarshaller = toQualName "Com.unmarshallCLSID"
, ref_marshaller = toQualName "Com.writeCLSID"
, ref_unmarshaller = toQualName "Com.readCLSID"
, alloc_type = Nothing
, free_type = Nothing
, prim_type = tyForeignPtr (tyQConst comLib "CLSID")
, c_type = "CLSID*"
, auto_type = toQualName "Com.CLSID"
, prim_size = toQualName "Com.sizeofCLSID"
, prim_sizeof = 16
, prim_align = 4
, is_pointed = True
, finalised = True
, attributes = Nothing
}
guid_ti :: TypeInfo
guid_ti =
TypeInfo
{ type_name = "GUID"
, haskell_type = toQualName "Com.GUID"
, marshaller = toQualName "Com.marshallGUID"
, copy_marshaller = toQualName "Com.copyGUID"
, unmarshaller = toQualName "Com.unmarshallGUID"
, ref_marshaller = toQualName "Com.writeGUID"
, ref_unmarshaller = toQualName "Com.readGUID"
, alloc_type = Nothing
, free_type = Nothing
, prim_type = tyForeignPtr (tyQConst comLib "GUID")
, c_type = "GUID*"
, auto_type = toQualName "Com.GUID"
, prim_size = toQualName "Com.sizeofGUID"
, prim_sizeof = 16
, prim_align = 4
, is_pointed = True
, finalised = True
, attributes = Nothing
}
mb_currency_ti :: Maybe TypeInfo
mb_currency_ti = Just currency_ti
currency_ti :: TypeInfo
currency_ti =
TypeInfo
{ type_name = "CURRENCY"
, haskell_type = toQualName "Automation.Currency"
, marshaller = toQualName "Automation.marshallCurrency"
, copy_marshaller = toQualName "Automation.marshallCurrency"
, unmarshaller = toQualName "Automation.unmarshallCurrency"
, ref_marshaller = toQualName "Automation.writeCurrency"
, ref_unmarshaller = toQualName "Automation.readCurrency"
, alloc_type = Nothing
, free_type = Nothing
, prim_type = tyInt64
, c_type = "CURRENCY"
, auto_type = toQualName "Automation.Currency"
, prim_size = toQualName "HDirect.sizeofInt64"
, prim_sizeof = lONGLONG_SIZE
, prim_align = lONGLONG_ALIGN_MODULUS
, is_pointed = False
, finalised = False
, attributes = Nothing
}
mb_date_ti :: Maybe TypeInfo
mb_date_ti = Just date_ti
date_ti :: TypeInfo
date_ti =
TypeInfo
{ type_name = "DATE"
, haskell_type = toQualName "Automation.Date"
, marshaller = toQualName "HDirect.marshallDouble"
, copy_marshaller = toQualName "HDirect.marshallDouble"
, unmarshaller = toQualName "HDirect.unmarshallDouble"
, ref_marshaller = toQualName "HDirect.writeDouble"
, ref_unmarshaller = toQualName "HDirect.readDouble"
, alloc_type = Nothing
, free_type = Nothing
, prim_type = tyDouble
, c_type = "double"
, auto_type = toQualName "Automation.Date"
, prim_size = toQualName "HDirect.sizeofDouble"
, prim_sizeof = dOUBLE_SIZE
, prim_align = dOUBLE_ALIGN_MODULUS
, is_pointed = False
, finalised = False
, attributes = Nothing
}
variant_ti :: TypeInfo
variant_ti
| optNoOverloadVariant || optServer =
TypeInfo
{ type_name = "VARIANT"
, haskell_type = toQualName "Automation.VARIANT"
, marshaller = toQualName "Automation.marshallVARIANT"
, copy_marshaller = toQualName "Automation.copyVARIANT"
, unmarshaller = toQualName "Automation.unmarshallVARIANT"
, ref_marshaller = toQualName "Automation.writeVARIANT"
, ref_unmarshaller = toQualName "Automation.readVARIANT"
, alloc_type = Just (toQualName "Automation.allocVARIANT")
, free_type = Nothing
, prim_type = (mkTyConst $ toQualName "Automation.VARIANT")
, c_type = "VARIANT"
, auto_type = toQualName "a"
, prim_size = toQualName "Automation.sizeofVARIANT"
, prim_sizeof = 16
, prim_align = 8
, is_pointed = True
, finalised = False
, attributes = Nothing
}
| otherwise =
TypeInfo
{ type_name = "VARIANT"
, haskell_type = toQualName "a"
, marshaller = toQualName "Automation.marshallVariant"
, copy_marshaller = toQualName "Automation.marshallVariant"
, unmarshaller = toQualName "Automation.unmarshallVariant"
, ref_marshaller = toQualName "Automation.writeVARIANT"
, ref_unmarshaller = toQualName "Automation.readVARIANT"
, alloc_type = Just (toQualName "Automation.allocVARIANT")
, free_type = Nothing
, prim_type = (mkTyConst $ toQualName "Automation.VARIANT")
, c_type = "VARIANT"
, auto_type = toQualName "a"
, prim_size = toQualName "Automation.sizeofVARIANT"
, prim_sizeof = 16
, prim_align = 8
, is_pointed = True
, finalised = False
, attributes = Nothing
}
v_bool_ti :: TypeInfo
v_bool_ti =
TypeInfo
{ type_name = "VARIANT_BOOL"
, haskell_type = toQualName "Prelude.Bool"
, marshaller = toQualName "Automation.marshallVARIANT_BOOL"
, copy_marshaller = toQualName "Automation.marshallVARIANT_BOOL"
, unmarshaller = toQualName "Automation.unmarshallVARIANT_BOOL"
, ref_marshaller = toQualName "Automation.writeVARIANT_BOOL"
, ref_unmarshaller = toQualName "Automation.readVARIANT_BOOL"
, alloc_type = Nothing
, free_type = Nothing
, prim_type = tyInt16
, c_type = "VARIANT_BOOL"
, auto_type = toQualName "Prelude.Bool"
, prim_size = toQualName "HDirect.sizeofInt16"
, prim_sizeof = sHORT_SIZE
, prim_align = sHORT_ALIGN_MODULUS
, is_pointed = False
, finalised = False
, attributes = Nothing
}
bstr_ti :: TypeInfo
bstr_ti =
TypeInfo
{ type_name = "BSTR"
, haskell_type = toQualName "Prelude.String"
, marshaller = toQualName "Com.marshallBSTR"
, copy_marshaller = toQualName "Com.marshallBSTR"
, unmarshaller = toQualName "Com.unmarshallBSTR"
, ref_marshaller = toQualName "Com.writeBSTR"
, ref_unmarshaller = toQualName "Com.readBSTR"
, alloc_type = Nothing
, free_type = Just (toQualName "Com.freeBSTR")
, prim_type = tyPtr tyString
, c_type = "void*"
, auto_type = toQualName "Prelude.String"
, prim_size = toQualName "HDirect.sizeofPtr"
, prim_sizeof = dATA_PTR_SIZE
, prim_align = dATA_PTR_ALIGN_MODULUS
, is_pointed = False
, finalised = False
, attributes = Nothing
}
\end{code}