From bc1115f7a542301011d4e2a3a632f9e75c9a89d3 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Sat, 29 Nov 2025 16:18:19 +0100 Subject: [PATCH 1/7] Add `foreignImportDecs` This function is intended to be a type of smart constructor, even thought it is currently just a shallow wrapper around the `ForeignImportDecl` constructor. This will change as we resolve issue #1282. --- hs-bindgen/hs-bindgen.cabal | 1 + .../HsBindgen/Backend/Extensions.hs | 5 +- .../HsBindgen/Backend/Hs/Translation.hs | 58 +++++++------- .../Backend/Hs/Translation/ForeignImport.hs | 39 ++++++++++ .../Backend/Hs/Translation/ToFromFunPtr.hs | 75 ++++++++++--------- 5 files changed, 111 insertions(+), 67 deletions(-) create mode 100644 hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs diff --git a/hs-bindgen/hs-bindgen.cabal b/hs-bindgen/hs-bindgen.cabal index 4674ae2db..d8f203ac1 100644 --- a/hs-bindgen/hs-bindgen.cabal +++ b/hs-bindgen/hs-bindgen.cabal @@ -86,6 +86,7 @@ library internal HsBindgen.Backend.Hs.Origin HsBindgen.Backend.Hs.Translation HsBindgen.Backend.Hs.Translation.Config + HsBindgen.Backend.Hs.Translation.ForeignImport HsBindgen.Backend.Hs.Translation.ToFromFunPtr HsBindgen.Backend.Hs.Translation.Type HsBindgen.Backend.HsModule.Capi diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Extensions.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Extensions.hs index dacfedd5c..a129c1f34 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Extensions.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Extensions.hs @@ -76,7 +76,10 @@ requiredExtensions = \case nestedDeriving :: [(Strategy ClosedType, [Global])] -> Set TH.Extension nestedDeriving deriv = Set.singleton TH.DerivingStrategies - <> mconcat (map (strategyExtensions . fst) deriv) + <> mconcat [ + strategyExtensions s <> foldMap globalExtensions gs + | (s, gs) <- deriv + ] recordExtensions :: Record -> Set TH.Extension recordExtensions r = foldMap fieldExtensions (dataFields r) diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs index e59de135c..297abcab9 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs @@ -20,6 +20,7 @@ import HsBindgen.Backend.Hs.Haddock.Documentation qualified as HsDoc import HsBindgen.Backend.Hs.Haddock.Translation import HsBindgen.Backend.Hs.Origin qualified as Origin import HsBindgen.Backend.Hs.Translation.Config +import HsBindgen.Backend.Hs.Translation.ForeignImport qualified as HsFI import HsBindgen.Backend.Hs.Translation.ToFromFunPtr qualified as ToFromFunPtr import HsBindgen.Backend.Hs.Translation.Type qualified as Type import HsBindgen.Backend.SHs.AST @@ -1425,31 +1426,31 @@ functionDecs :: -> C.Function -> C.DeclSpec -> [Hs.Decl] -functionDecs safety opts haddockConfig moduleName info f _spec = - funDecl : [ - hsWrapperDeclFunction highlevelName importName res wrappedArgTypes wrapParsedArgs f mbWrapComment +functionDecs safety opts haddockConfig moduleName info f _spec = concat [ + funDecls + , [ hsWrapperDeclFunction highlevelName importName res wrappedArgTypes wrapParsedArgs f mbWrapComment | areFancy ] + ] where areFancy = anyFancy (res : wrappedArgTypes) - funDecl :: Hs.Decl - funDecl = Hs.DeclForeignImport $ Hs.ForeignImportDecl - { foreignImportName = importName - , foreignImportResultType = snd resType - , foreignImportParameters = if areFancy then ffiParams else ffiParsedArgs - , foreignImportOrigName = uniqueCName wrapperName - , foreignImportCallConv = CallConvUserlandCAPI userlandCapiWrapper - , foreignImportOrigin = Origin.Function f - , foreignImportSafety = safety - - , foreignImportComment = mconcat [ + funDecls :: [Hs.Decl] + funDecls = + HsFI.foreignImportDecs + importName + (snd resType) + (if areFancy then ffiParams else ffiParsedArgs) + (uniqueCName wrapperName) + (CallConvUserlandCAPI userlandCapiWrapper) + (Origin.Function f) + (mconcat [ if areFancy then Just nonFancyComment else mbFFIComment , ioComment , Just $ HsDoc.uniqueSymbol wrapperName - ] - } + ]) + safety userlandCapiWrapper :: UserlandCapiWrapper userlandCapiWrapper = UserlandCapiWrapper { @@ -1733,7 +1734,7 @@ addressStubDecs :: , Hs.Name 'Hs.NsVar ) addressStubDecs opts haddockConfig moduleName info ty _spec = - (foreignImport : runnerDecls, runnerName) + (foreignImport ++ runnerDecls, runnerName) where -- *** Stub (impure) *** @@ -1777,21 +1778,20 @@ addressStubDecs opts haddockConfig moduleName info ty _spec = mbComment = generateHaddocksWithInfo haddockConfig info - foreignImport :: Hs.Decl - foreignImport = Hs.DeclForeignImport $ Hs.ForeignImportDecl - { foreignImportName = stubImportName - , foreignImportParameters = [] - , foreignImportResultType = stubImportType - , foreignImportOrigName = uniqueCName stubName - , foreignImportCallConv = CallConvUserlandCAPI userlandCapiWrapper - , foreignImportOrigin = Origin.Global ty - , foreignImportComment = Just $ HsDoc.uniqueSymbol stubName - + foreignImport :: [Hs.Decl] + foreignImport = + HsFI.foreignImportDecs + stubImportName + stubImportType + [] + (uniqueCName stubName) + (CallConvUserlandCAPI userlandCapiWrapper) + (Origin.Global ty) + (Just $ HsDoc.uniqueSymbol stubName) -- These imports can be unsafe. We're binding to simple address stubs, -- so there are no callbacks into Haskell code. Moreover, they are -- short running code. - , foreignImportSafety = SHs.Unsafe - } + SHs.Unsafe -- *** Stub (pure) *** diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs new file mode 100644 index 000000000..dbef42a4a --- /dev/null +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs @@ -0,0 +1,39 @@ +-- | Generate Haskell foreign imports +module HsBindgen.Backend.Hs.Translation.ForeignImport ( + foreignImportDecs + ) where + +import HsBindgen.Backend.Hs.AST qualified as Hs +import HsBindgen.Backend.Hs.AST.Type +import HsBindgen.Backend.Hs.CallConv +import HsBindgen.Backend.Hs.Haddock.Documentation qualified as HsDoc +import HsBindgen.Backend.Hs.Origin qualified as Origin +import HsBindgen.Backend.SHs.AST +import HsBindgen.Frontend.Naming qualified as C +import HsBindgen.Language.Haskell qualified as Hs + +foreignImportDecs :: + Hs.Name 'Hs.NsVar + -> HsType + -> [Hs.FunctionParameter] + -> C.Name + -> CallConv + -> Origin.ForeignImport + -> Maybe HsDoc.Comment + -> Safety + -> [Hs.Decl] +foreignImportDecs name resultType parameters origName callConv origin comment safety = + [ Hs.DeclForeignImport foreignImportDecl ] + -- TODO: prevent the "newtype constructor not in scope" bug. See issue #1282. + where + foreignImportDecl :: Hs.ForeignImportDecl + foreignImportDecl = Hs.ForeignImportDecl + { foreignImportName = name + , foreignImportResultType = resultType + , foreignImportParameters = parameters + , foreignImportOrigName = origName + , foreignImportCallConv = callConv + , foreignImportOrigin = origin + , foreignImportComment = comment + , foreignImportSafety = safety + } diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ToFromFunPtr.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ToFromFunPtr.hs index bbcbbff36..d3af4b289 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ToFromFunPtr.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ToFromFunPtr.hs @@ -15,6 +15,7 @@ import HsBindgen.Backend.Hs.AST.Type import HsBindgen.Backend.Hs.CallConv import HsBindgen.Backend.Hs.Haddock.Documentation qualified as HsDoc import HsBindgen.Backend.Hs.Origin qualified as Origin +import HsBindgen.Backend.Hs.Translation.ForeignImport qualified as HsFI import HsBindgen.Backend.Hs.Translation.Type qualified as Type import HsBindgen.Backend.HsModule.Render () import HsBindgen.Backend.SHs.AST qualified as SHs @@ -80,50 +81,50 @@ instancesFor :: -> C.Type -- ^ Type of the C function -> HsType -- ^ Corresponding Haskell type -> [Hs.Decl] -instancesFor (nameTo, nameToComment) (nameFrom, nameFromComment) funC funHs = [ +instancesFor (nameTo, nameToComment) (nameFrom, nameFromComment) funC funHs = concat [ -- import for @ToFunPtr@ instance - Hs.DeclForeignImport Hs.ForeignImportDecl{ - foreignImportName = nameTo - , foreignImportResultType = HsIO (HsFunPtr funHs) - , foreignImportParameters = [wrapperParam funHs] - , foreignImportOrigName = "wrapper" - , foreignImportCallConv = CallConvGhcCCall ImportAsValue - , foreignImportOrigin = Origin.ToFunPtr funC - , foreignImportComment = nameToComment - , foreignImportSafety = SHs.Safe - } + HsFI.foreignImportDecs + nameTo + (HsIO (HsFunPtr funHs)) + [wrapperParam funHs] + "wrapper" + (CallConvGhcCCall ImportAsValue) + (Origin.ToFunPtr funC) + nameToComment + SHs.Safe -- import for @FromFunPtr@ instance - , Hs.DeclForeignImport Hs.ForeignImportDecl{ - foreignImportName = nameFrom - , foreignImportResultType = funHs - , foreignImportParameters = [wrapperParam $ HsFunPtr funHs] - , foreignImportOrigName = "dynamic" - , foreignImportCallConv = CallConvGhcCCall ImportAsValue - , foreignImportOrigin = Origin.FromFunPtr funC - , foreignImportComment = nameFromComment - , foreignImportSafety = SHs.Safe - } + , HsFI.foreignImportDecs + nameFrom + funHs + [wrapperParam $ HsFunPtr funHs] + "dynamic" + (CallConvGhcCCall ImportAsValue) + (Origin.ToFunPtr funC) + nameFromComment + SHs.Safe -- @ToFunPtr@ instance proper - , Hs.DeclDefineInstance Hs.DefineInstance{ - defineInstanceComment = Nothing - , defineInstanceDeclarations = Hs.InstanceToFunPtr - Hs.ToFunPtrInstance{ - toFunPtrInstanceType = funHs - , toFunPtrInstanceBody = nameTo - } - } + , [ Hs.DeclDefineInstance Hs.DefineInstance{ + defineInstanceComment = Nothing + , defineInstanceDeclarations = Hs.InstanceToFunPtr + Hs.ToFunPtrInstance{ + toFunPtrInstanceType = funHs + , toFunPtrInstanceBody = nameTo + } + } + ] -- @FromFunPtr@ instance proper - , Hs.DeclDefineInstance Hs.DefineInstance{ - defineInstanceComment = Nothing - , defineInstanceDeclarations = Hs.InstanceFromFunPtr - Hs.FromFunPtrInstance{ - fromFunPtrInstanceType = funHs - , fromFunPtrInstanceBody = nameFrom - } - } + , [ Hs.DeclDefineInstance Hs.DefineInstance{ + defineInstanceComment = Nothing + , defineInstanceDeclarations = Hs.InstanceFromFunPtr + Hs.FromFunPtrInstance{ + fromFunPtrInstanceType = funHs + , fromFunPtrInstanceBody = nameFrom + } + } + ] ] wrapperParam :: HsType -> Hs.FunctionParameter From 4a2d1d93f184d039f586658c8dc60ecded3f5cb8 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Mon, 1 Dec 2025 15:34:09 +0100 Subject: [PATCH 2/7] Put `InstanceMap` in its own module --- hs-bindgen/hs-bindgen.cabal | 1 + .../HsBindgen/Backend/Hs/Translation.hs | 203 ++---------------- .../Backend/Hs/Translation/Instances.hs | 174 +++++++++++++++ 3 files changed, 195 insertions(+), 183 deletions(-) create mode 100644 hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs diff --git a/hs-bindgen/hs-bindgen.cabal b/hs-bindgen/hs-bindgen.cabal index d8f203ac1..daeafe485 100644 --- a/hs-bindgen/hs-bindgen.cabal +++ b/hs-bindgen/hs-bindgen.cabal @@ -87,6 +87,7 @@ library internal HsBindgen.Backend.Hs.Translation HsBindgen.Backend.Hs.Translation.Config HsBindgen.Backend.Hs.Translation.ForeignImport + HsBindgen.Backend.Hs.Translation.Instances HsBindgen.Backend.Hs.Translation.ToFromFunPtr HsBindgen.Backend.Hs.Translation.Type HsBindgen.Backend.HsModule.Capi diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs index 297abcab9..0915fb5bc 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs @@ -21,13 +21,13 @@ import HsBindgen.Backend.Hs.Haddock.Translation import HsBindgen.Backend.Hs.Origin qualified as Origin import HsBindgen.Backend.Hs.Translation.Config import HsBindgen.Backend.Hs.Translation.ForeignImport qualified as HsFI +import HsBindgen.Backend.Hs.Translation.Instances qualified as Hs import HsBindgen.Backend.Hs.Translation.ToFromFunPtr qualified as ToFromFunPtr import HsBindgen.Backend.Hs.Translation.Type qualified as Type import HsBindgen.Backend.SHs.AST import HsBindgen.Backend.SHs.AST qualified as SHs import HsBindgen.Backend.SHs.Translation qualified as SHs import HsBindgen.Backend.UniqueSymbol -import HsBindgen.BindingSpec qualified as BindingSpec import HsBindgen.Config.Internal import HsBindgen.Errors import HsBindgen.Frontend.Analysis.DeclIndex @@ -143,176 +143,13 @@ isDefinedInCurrentModule declIndex = qualPrelimDeclId :: C.QualPrelimDeclId qualPrelimDeclId = C.qualDeclIdToQualPrelimDeclId qualDeclId -{------------------------------------------------------------------------------- - Instance Map --------------------------------------------------------------------------------} - -type InstanceMap = Map (Hs.Name Hs.NsTypeConstr) (Set Hs.TypeClass) - -getInstances :: - HasCallStack - => InstanceMap -- ^ Current state - -> Hs.Name Hs.NsTypeConstr -- ^ Name of current type - -> Set Hs.TypeClass -- ^ Candidate instances - -> [HsType] -- ^ Dependencies - -> Set Hs.TypeClass -getInstances instanceMap name = aux - where - aux :: Set Hs.TypeClass -> [HsType] -> Set Hs.TypeClass - aux acc [] = acc - aux acc (hsType:hsTypes) - | Set.null acc = acc - | otherwise = case hsType of - HsPrimType primType -> aux (acc /\ hsPrimTypeInsts primType) hsTypes - HsTypRef name' - | name' == name -> aux acc hsTypes - | otherwise -> case Map.lookup name' instanceMap of - Just instances -> aux (acc /\ instances) hsTypes - Nothing -> panicPure $ "type not found: " ++ show name' - HsConstArray _n hsType' -> - -- constrain by ConstantArray item type in next step - aux (acc /\ cArrayInsts) $ hsType' : hsTypes - HsIncompleteArray hsType' -> - -- constrain by Array item type in next step - aux (acc /\ arrayInsts) $ hsType' : hsTypes - HsPtr{} -> aux (acc /\ ptrInsts) hsTypes - HsFunPtr{} -> aux (acc /\ ptrInsts) hsTypes - HsIO{} -> Set.empty - HsFun{} -> Set.empty - HsExtBinding _ref _cTypeSpec mHsTypeSpec -> - let acc' = case mHsTypeSpec of - Just hsTypeSpec -> acc /\ hsTypeSpecInsts hsTypeSpec - Nothing -> acc - in aux acc' hsTypes - HsByteArray{} -> - let acc' = acc /\ Set.fromList [Hs.Eq, Hs.Ord, Hs.Show] - in aux acc' hsTypes - HsSizedByteArray{} -> - let acc' = acc /\ Set.fromList [Hs.Eq, Hs.Show] - in aux acc' hsTypes - HsBlock t -> - aux acc (t:hsTypes) - HsComplexType primType -> aux (acc /\ hsPrimTypeInsts primType) hsTypes - HsStrLit{} -> Set.empty - - (/\) :: Ord a => Set a -> Set a -> Set a - (/\) = Set.intersection - - hsPrimTypeInsts :: HsPrimType -> Set Hs.TypeClass - hsPrimTypeInsts = \case - HsPrimVoid -> Set.fromList [Hs.Eq, Hs.Ix, Hs.Ord, Hs.Read, Hs.Show] - HsPrimUnit -> unitInsts - HsPrimCChar -> integralInsts - HsPrimCSChar -> integralInsts - HsPrimCUChar -> integralInsts - HsPrimCInt -> integralInsts - HsPrimCUInt -> integralInsts - HsPrimCShort -> integralInsts - HsPrimCUShort -> integralInsts - HsPrimCLong -> integralInsts - HsPrimCULong -> integralInsts - HsPrimCPtrDiff -> integralInsts - HsPrimCSize -> integralInsts - HsPrimCLLong -> integralInsts - HsPrimCULLong -> integralInsts - HsPrimCBool -> integralInsts - HsPrimCFloat -> floatingInsts - HsPrimCDouble -> floatingInsts - HsPrimCStringLen -> Set.fromList [Hs.Eq, Hs.Ord, Hs.Show] - HsPrimInt -> integralInsts - - unitInsts :: Set Hs.TypeClass - unitInsts = Set.fromList [ - Hs.Eq - , Hs.Ord - , Hs.Read - , Hs.ReadRaw - , Hs.Show - , Hs.StaticSize - , Hs.Storable - , Hs.WriteRaw - ] - - integralInsts :: Set Hs.TypeClass - integralInsts = Set.fromList [ - Hs.Bits - , Hs.Bounded - , Hs.Enum - , Hs.Eq - , Hs.FiniteBits - , Hs.Integral - , Hs.Ix - , Hs.Num - , Hs.Ord - , Hs.Read - , Hs.ReadRaw - , Hs.Real - , Hs.Show - , Hs.StaticSize - , Hs.Storable - , Hs.WriteRaw - ] - - floatingInsts :: Set Hs.TypeClass - floatingInsts = Set.fromList [ - Hs.Enum - , Hs.Eq - , Hs.Floating - , Hs.Fractional - , Hs.Num - , Hs.Ord - , Hs.Read - , Hs.ReadRaw - , Hs.Real - , Hs.RealFloat - , Hs.RealFrac - , Hs.Show - , Hs.StaticSize - , Hs.Storable - , Hs.WriteRaw - ] - - ptrInsts :: Set Hs.TypeClass - ptrInsts = Set.fromList [ - Hs.Eq - , Hs.Ord - , Hs.ReadRaw - , Hs.Show - , Hs.StaticSize - , Hs.Storable - , Hs.WriteRaw - ] - - cArrayInsts :: Set Hs.TypeClass - cArrayInsts = Set.fromList [ - Hs.Eq - , Hs.ReadRaw - , Hs.Show - , Hs.StaticSize - , Hs.Storable - , Hs.WriteRaw - ] - - arrayInsts :: Set Hs.TypeClass - arrayInsts = Set.fromList [ - Hs.Eq - , Hs.Show - ] - - hsTypeSpecInsts :: BindingSpec.HsTypeSpec -> Set Hs.TypeClass - hsTypeSpecInsts hsTypeSpec = Set.fromAscList [ - cls - | (cls, BindingSpec.Require{}) <- - Map.toAscList (BindingSpec.hsTypeSpecInstances hsTypeSpec) - ] - {------------------------------------------------------------------------------- Declarations ------------------------------------------------------------------------------} -- TODO: Take DeclSpec into account generateDecs :: - State.MonadState InstanceMap m + State.MonadState Hs.InstanceMap m => TranslationConfig -> HaddockConfig -> BaseModuleName @@ -367,7 +204,7 @@ reifyStructFields struct k = Vec.reifyList (C.structFields struct) k -- | Generate declarations for given C struct structDecs :: forall n m. - (SNatI n, State.MonadState InstanceMap m) + (SNatI n, State.MonadState Hs.InstanceMap m) => TranslationConfig -> HaddockConfig -> C.DeclInfo @@ -396,7 +233,7 @@ structDecs opts haddockConfig info struct spec fields = do Set.fromList (snd <$> translationDeriveStruct opts) -- everything in aux is state-dependent - aux :: InstanceMap -> (Set Hs.TypeClass, [Hs.Decl]) + aux :: Hs.InstanceMap -> (Set Hs.TypeClass, [Hs.Decl]) aux instanceMap = (insts,) $ structDecl : storableDecl ++ optDecls ++ hasFlamDecl ++ concatMap (structFieldDecls structName) (C.structFields struct) @@ -404,7 +241,7 @@ structDecs opts haddockConfig info struct spec fields = do -- #1286. where insts :: Set Hs.TypeClass - insts = getInstances instanceMap structName candidateInsts $ + insts = Hs.getInstances instanceMap structName candidateInsts $ Hs.fieldType <$> Vec.toList structFields hsStruct :: Hs.Struct n @@ -568,7 +405,7 @@ pokeStructField ptr f x = case C.structFieldWidth f of -------------------------------------------------------------------------------} opaqueDecs :: - State.MonadState InstanceMap m + State.MonadState Hs.InstanceMap m => C.NameKind -> HaddockConfig -> C.DeclInfo @@ -597,7 +434,7 @@ opaqueDecs cNameKind haddockConfig info spec = do -------------------------------------------------------------------------------} unionDecs :: - State.MonadState InstanceMap m + State.MonadState Hs.InstanceMap m => HaddockConfig -> C.DeclInfo -> C.Union @@ -654,7 +491,7 @@ unionDecs haddockConfig info union spec = do (fromIntegral (C.unionAlignment union)) -- everything in aux is state-dependent - aux :: InstanceMap -> [Hs.Decl] + aux :: Hs.InstanceMap -> [Hs.Decl] aux instanceMap = newtypeDecl : storableDecl : accessorDecls ++ concatMap (unionFieldDecls newtypeName) (C.unionFields union) @@ -666,7 +503,7 @@ unionDecs haddockConfig info union spec = do getAccessorDecls :: C.UnionField -> [Hs.Decl] getAccessorDecls C.UnionField{..} = let hsType = Type.topLevel unionFieldType - fInsts = getInstances instanceMap newtypeName insts [hsType] + fInsts = Hs.getInstances instanceMap newtypeName insts [hsType] getterName = "get_" <> C.nameHs (C.fieldName unionFieldInfo) setterName = "set_" <> C.nameHs (C.fieldName unionFieldInfo) commentRefName name = Just $ HsDoc.paragraph [ @@ -780,7 +617,7 @@ unionFieldDecls unionName f = [ -------------------------------------------------------------------------------} enumDecs :: - State.MonadState InstanceMap m + State.MonadState Hs.InstanceMap m => TranslationConfig -> HaddockConfig -> C.DeclInfo @@ -924,7 +761,7 @@ enumDecs opts haddockConfig info e spec = do -------------------------------------------------------------------------------} typedefDecs :: - State.MonadState InstanceMap m + State.MonadState Hs.InstanceMap m => TranslationConfig -> HaddockConfig -> C.DeclInfo @@ -976,14 +813,14 @@ typedefDecs opts haddockConfig info typedef spec = do _ -> [] -- everything in aux is state-dependent - aux :: InstanceMap -> (Set Hs.TypeClass, [Hs.Decl]) + aux :: Hs.InstanceMap -> (Set Hs.TypeClass, [Hs.Decl]) aux instanceMap = (insts,) $ (newtypeDecl : newtypeWrapper) ++ storableDecl ++ optDecls ++ typedefFieldDecls hsNewtype where insts :: Set Hs.TypeClass insts = - getInstances + Hs.getInstances instanceMap newtypeName candidateInsts @@ -1101,7 +938,7 @@ typedefFieldDecls hsNewType = [ -------------------------------------------------------------------------------} macroDecs :: - State.MonadState InstanceMap m + State.MonadState Hs.InstanceMap m => TranslationConfig -> HaddockConfig -> C.DeclInfo @@ -1114,7 +951,7 @@ macroDecs opts haddockConfig info checkedMacro spec = C.MacroExpr expr -> pure $ macroVarDecs haddockConfig info expr macroDecsTypedef :: - State.MonadState InstanceMap m + State.MonadState Hs.InstanceMap m => TranslationConfig -> HaddockConfig -> C.DeclInfo @@ -1134,7 +971,7 @@ macroDecsTypedef opts haddockConfig info macroType spec = do Set.fromList (snd <$> translationDeriveTypedef opts) -- everything in aux is state-dependent - aux :: C.Type -> InstanceMap -> (Set Hs.TypeClass, [Hs.Decl]) + aux :: C.Type -> Hs.InstanceMap -> (Set Hs.TypeClass, [Hs.Decl]) aux ty instanceMap = (insts,) $ newtypeDecl : storableDecl ++ optDecls where @@ -1142,7 +979,7 @@ macroDecsTypedef opts haddockConfig info macroType spec = do fieldType = Type.topLevel ty insts :: Set Hs.TypeClass - insts = getInstances instanceMap newtypeName candidateInsts [fieldType] + insts = Hs.getInstances instanceMap newtypeName candidateInsts [fieldType] hsNewtype :: Hs.Newtype hsNewtype = Hs.Newtype { @@ -1640,7 +1477,7 @@ global :: TranslationConfig -> HaddockConfig -> BaseModuleName - -> InstanceMap + -> Hs.InstanceMap -> C.DeclInfo -> C.Type -> C.DeclSpec @@ -1672,7 +1509,7 @@ global opts haddockConfig moduleName instsMap info ty _spec -- unknown size do not have a 'Storable' instance. constGetter :: HsType - -> InstanceMap + -> Hs.InstanceMap -> C.DeclInfo -> Hs.Name Hs.NsVar -> [Hs.Decl] @@ -1693,7 +1530,7 @@ constGetter ty instsMap info pureStubName = concat [ -- superclass constraints. See issue #993. Hs.Storable `elem` - getInstances instsMap "unused" (Set.singleton Hs.Storable) [ty] + Hs.getInstances instsMap "unused" (Set.singleton Hs.Storable) [ty] ] where -- *** Getter *** diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs new file mode 100644 index 000000000..c9be500f8 --- /dev/null +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs @@ -0,0 +1,174 @@ +-- | Type classes, instances, and constraints +module HsBindgen.Backend.Hs.Translation.Instances ( + InstanceMap + , getInstances + ) where + +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set + +import HsBindgen.Backend.Hs.AST +import HsBindgen.Backend.Hs.AST.Type +import HsBindgen.BindingSpec +import HsBindgen.Errors +import HsBindgen.Imports +import HsBindgen.Language.Haskell + +type InstanceMap = Map (Name NsTypeConstr) (Set TypeClass) + +getInstances :: + HasCallStack + => InstanceMap -- ^ Current state + -> Name NsTypeConstr -- ^ Name of current type + -> Set TypeClass -- ^ Candidate instances + -> [HsType] -- ^ Dependencies + -> Set TypeClass +getInstances instanceMap name = aux + where + aux :: Set TypeClass -> [HsType] -> Set TypeClass + aux acc [] = acc + aux acc (hsType:hsTypes) + | Set.null acc = acc + | otherwise = case hsType of + HsPrimType primType -> aux (acc /\ hsPrimTypeInsts primType) hsTypes + HsTypRef name' + | name' == name -> aux acc hsTypes + | otherwise -> case Map.lookup name' instanceMap of + Just instances -> aux (acc /\ instances) hsTypes + Nothing -> panicPure $ "type not found: " ++ show name' + HsConstArray _n hsType' -> + -- constrain by ConstantArray item type in next step + aux (acc /\ cArrayInsts) $ hsType' : hsTypes + HsIncompleteArray hsType' -> + -- constrain by Array item type in next step + aux (acc /\ arrayInsts) $ hsType' : hsTypes + HsPtr{} -> aux (acc /\ ptrInsts) hsTypes + HsFunPtr{} -> aux (acc /\ ptrInsts) hsTypes + HsIO{} -> Set.empty + HsFun{} -> Set.empty + HsExtBinding _ref _cTypeSpec mHsTypeSpec -> + let acc' = case mHsTypeSpec of + Just hsTypeSpec -> acc /\ hsTypeSpecInsts hsTypeSpec + Nothing -> acc + in aux acc' hsTypes + HsByteArray{} -> + let acc' = acc /\ Set.fromList [Eq, Ord, Show] + in aux acc' hsTypes + HsSizedByteArray{} -> + let acc' = acc /\ Set.fromList [Eq, Show] + in aux acc' hsTypes + HsBlock t -> + aux acc (t:hsTypes) + HsComplexType primType -> aux (acc /\ hsPrimTypeInsts primType) hsTypes + HsStrLit{} -> Set.empty + + (/\) :: Ord a => Set a -> Set a -> Set a + (/\) = Set.intersection + + hsPrimTypeInsts :: HsPrimType -> Set TypeClass + hsPrimTypeInsts = \case + HsPrimVoid -> Set.fromList [Eq, Ix, Ord, Read, Show] + HsPrimUnit -> unitInsts + HsPrimCChar -> integralInsts + HsPrimCSChar -> integralInsts + HsPrimCUChar -> integralInsts + HsPrimCInt -> integralInsts + HsPrimCUInt -> integralInsts + HsPrimCShort -> integralInsts + HsPrimCUShort -> integralInsts + HsPrimCLong -> integralInsts + HsPrimCULong -> integralInsts + HsPrimCPtrDiff -> integralInsts + HsPrimCSize -> integralInsts + HsPrimCLLong -> integralInsts + HsPrimCULLong -> integralInsts + HsPrimCBool -> integralInsts + HsPrimCFloat -> floatingInsts + HsPrimCDouble -> floatingInsts + HsPrimCStringLen -> Set.fromList [Eq, Ord, Show] + HsPrimInt -> integralInsts + + unitInsts :: Set TypeClass + unitInsts = Set.fromList [ + Eq + , Ord + , Read + , ReadRaw + , Show + , StaticSize + , Storable + , WriteRaw + ] + + integralInsts :: Set TypeClass + integralInsts = Set.fromList [ + Bits + , Bounded + , Enum + , Eq + , FiniteBits + , Integral + , Ix + , Num + , Ord + , Read + , ReadRaw + , Real + , Show + , StaticSize + , Storable + , WriteRaw + ] + + floatingInsts :: Set TypeClass + floatingInsts = Set.fromList [ + Enum + , Eq + , Floating + , Fractional + , Num + , Ord + , Read + , ReadRaw + , Real + , RealFloat + , RealFrac + , Show + , StaticSize + , Storable + , WriteRaw + ] + + ptrInsts :: Set TypeClass + ptrInsts = Set.fromList [ + Eq + , Ord + , ReadRaw + , Show + , StaticSize + , Storable + , WriteRaw + ] + + cArrayInsts :: Set TypeClass + cArrayInsts = Set.fromList [ + Eq + , ReadRaw + , Show + , StaticSize + , Storable + , WriteRaw + ] + + arrayInsts :: Set TypeClass + arrayInsts = Set.fromList [ + Eq + , Show + ] + + hsTypeSpecInsts :: HsTypeSpec -> Set TypeClass + hsTypeSpecInsts hsTypeSpec = Set.fromAscList [ + cls + | (cls, Require{}) <- + Map.toAscList (hsTypeSpecInstances hsTypeSpec) + ] From 339922e0af5917f673abe299169f3a370a2a3106 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Mon, 1 Dec 2025 15:48:30 +0100 Subject: [PATCH 3/7] Make current type name optional in `getInstances` --- .../src-internal/HsBindgen/Backend/Hs/Translation.hs | 10 +++++----- .../HsBindgen/Backend/Hs/Translation/Instances.hs | 10 +++++----- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs index 0915fb5bc..87563eeb0 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs @@ -241,7 +241,7 @@ structDecs opts haddockConfig info struct spec fields = do -- #1286. where insts :: Set Hs.TypeClass - insts = Hs.getInstances instanceMap structName candidateInsts $ + insts = Hs.getInstances instanceMap (Just structName) candidateInsts $ Hs.fieldType <$> Vec.toList structFields hsStruct :: Hs.Struct n @@ -503,7 +503,7 @@ unionDecs haddockConfig info union spec = do getAccessorDecls :: C.UnionField -> [Hs.Decl] getAccessorDecls C.UnionField{..} = let hsType = Type.topLevel unionFieldType - fInsts = Hs.getInstances instanceMap newtypeName insts [hsType] + fInsts = Hs.getInstances instanceMap (Just newtypeName) insts [hsType] getterName = "get_" <> C.nameHs (C.fieldName unionFieldInfo) setterName = "set_" <> C.nameHs (C.fieldName unionFieldInfo) commentRefName name = Just $ HsDoc.paragraph [ @@ -822,7 +822,7 @@ typedefDecs opts haddockConfig info typedef spec = do insts = Hs.getInstances instanceMap - newtypeName + (Just newtypeName) candidateInsts [Hs.fieldType newtypeField] @@ -979,7 +979,7 @@ macroDecsTypedef opts haddockConfig info macroType spec = do fieldType = Type.topLevel ty insts :: Set Hs.TypeClass - insts = Hs.getInstances instanceMap newtypeName candidateInsts [fieldType] + insts = Hs.getInstances instanceMap (Just newtypeName) candidateInsts [fieldType] hsNewtype :: Hs.Newtype hsNewtype = Hs.Newtype { @@ -1530,7 +1530,7 @@ constGetter ty instsMap info pureStubName = concat [ -- superclass constraints. See issue #993. Hs.Storable `elem` - Hs.getInstances instsMap "unused" (Set.singleton Hs.Storable) [ty] + Hs.getInstances instsMap Nothing (Set.singleton Hs.Storable) [ty] ] where -- *** Getter *** diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs index c9be500f8..22c46601a 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs @@ -18,10 +18,10 @@ type InstanceMap = Map (Name NsTypeConstr) (Set TypeClass) getInstances :: HasCallStack - => InstanceMap -- ^ Current state - -> Name NsTypeConstr -- ^ Name of current type - -> Set TypeClass -- ^ Candidate instances - -> [HsType] -- ^ Dependencies + => InstanceMap -- ^ Current state + -> Maybe (Name NsTypeConstr) -- ^ Name of current type (optionaL) + -> Set TypeClass -- ^ Candidate instances + -> [HsType] -- ^ Dependencies -> Set TypeClass getInstances instanceMap name = aux where @@ -32,7 +32,7 @@ getInstances instanceMap name = aux | otherwise = case hsType of HsPrimType primType -> aux (acc /\ hsPrimTypeInsts primType) hsTypes HsTypRef name' - | name' == name -> aux acc hsTypes + | Just name' == name -> aux acc hsTypes | otherwise -> case Map.lookup name' instanceMap of Just instances -> aux (acc /\ instances) hsTypes Nothing -> panicPure $ "type not found: " ++ show name' From e85f424f3167d218566b35ba40c1b216e303cc0b Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Thu, 27 Nov 2025 23:55:37 +0100 Subject: [PATCH 4/7] WIP: add example of constructor import issue to the manual --- manual/.gitignore | 3 ++- manual/c/Makefile | 10 ++++++++- manual/c/foreign_types.c | 7 ++++++ manual/c/foreign_types.h | 11 ++++++++++ manual/generate.sh | 41 ++++++++++++++++++++++++++++++++++- manual/hs/manual/manual.cabal | 16 ++++++++++++++ 6 files changed, 85 insertions(+), 3 deletions(-) create mode 100644 manual/c/foreign_types.c create mode 100644 manual/c/foreign_types.h diff --git a/manual/.gitignore b/manual/.gitignore index 53913f716..e8809d06b 100644 --- a/manual/.gitignore +++ b/manual/.gitignore @@ -5,6 +5,7 @@ ## Binding specs external/ ## Haskell files -hs/manual/generated/**/*.hs +hs/manual/generated/**/* +hs/manual/src-foreign-types/Generated/* hs/hs-game/generated/**/*.hs hs/hs-vector/generated/**/*.hs diff --git a/manual/c/Makefile b/manual/c/Makefile index f9ebc136e..a663a8eed 100644 --- a/manual/c/Makefile +++ b/manual/c/Makefile @@ -27,7 +27,7 @@ ifeq ($(LLVM_BACKEND),1) EXTRAFLAGS:= endif -default: libexample${TARGET_EXT} libvector${TARGET_EXT} libgame${TARGET_EXT} libstructs${TARGET_EXT} libglobals${TARGET_EXT} libarrays${TARGET_EXT} libfunctionpointers${TARGET_EXT} libhsb_complex_test${TARGET_EXT} libcallbacks${TARGET_EXT} libzerocopy${TARGET_EXT} +default: libexample${TARGET_EXT} libvector${TARGET_EXT} libgame${TARGET_EXT} libstructs${TARGET_EXT} libglobals${TARGET_EXT} libarrays${TARGET_EXT} libfunctionpointers${TARGET_EXT} libhsb_complex_test${TARGET_EXT} libcallbacks${TARGET_EXT} libzerocopy${TARGET_EXT} libforeign_types${TARGET_EXT} .PHONY: clean clean: @@ -83,6 +83,14 @@ libzerocopy${TARGET_EXT}: zero_copy.o zero_copy.o: zero_copy.c zero_copy.h gcc ${EXTRAFLAGS} -Wall -o zero_copy.o -c -fPIC zero_copy.c +# Manual: foreign types + +libforeign_types${TARGET_EXT}: foreign_types.o + gcc ${EXTRAFLAGS} -Wall -shared -o libforeign_types${TARGET_EXT} foreign_types.o + +foreign_types.o: foreign_types.c foreign_types.h + gcc ${EXTRAFLAGS} -Wall -o foreign_types.o -c -fPIC foreign_types.c + # Example for external bindings libvector${TARGET_EXT}: vector.o vector_length.o vector_rotate.o diff --git a/manual/c/foreign_types.c b/manual/c/foreign_types.c new file mode 100644 index 000000000..19645308a --- /dev/null +++ b/manual/c/foreign_types.c @@ -0,0 +1,7 @@ +#include "foreign_types.h" + +B ex_global = 10; + +B ex_func (B x) { + return x; +} \ No newline at end of file diff --git a/manual/c/foreign_types.h b/manual/c/foreign_types.h new file mode 100644 index 000000000..b9a042ff6 --- /dev/null +++ b/manual/c/foreign_types.h @@ -0,0 +1,11 @@ +typedef int A; + +typedef A B; + +extern B ex_global; + +extern B ex_func (B x); + +typedef B ex_func_tydef (B x); + +typedef B (*ex_func_ptr_tydef) (B x); diff --git a/manual/generate.sh b/manual/generate.sh index 118486fc4..d06f7eb23 100755 --- a/manual/generate.sh +++ b/manual/generate.sh @@ -20,7 +20,7 @@ fi mkdir -p external echo "# " -echo "# Basic examples" +echo "# Manual" echo "# " mkdir -p hs/manual/generated @@ -89,6 +89,45 @@ cabal run hs-bindgen-cli -- \ --module ZeroCopy \ zero_copy.h + +echo "# " +echo "# Manual: foreign types" +echo "# " + +cabal run hs-bindgen-cli -- \ + preprocess \ + -I c/ \ + --unique-id com.hs-bindgen.manual.foreign-types \ + --hs-output-dir hs/manual/src-foreign-types \ + --module Generated.ForeignTypes.A \ + --select-by-decl-name "A" \ + --gen-binding-spec hs/manual/src-foreign-types/Generated/ForeignTypes/A.bindingspec.yaml \ + --create-output-dirs \ + foreign_types.h + +cabal run hs-bindgen-cli -- \ + preprocess \ + -I c/ \ + --unique-id com.hs-bindgen.manual.foreign-types \ + --hs-output-dir hs/manual/src-foreign-types \ + --module Generated.ForeignTypes.B \ + --select-by-decl-name "B" \ + --gen-binding-spec hs/manual/src-foreign-types/Generated/ForeignTypes/B.bindingspec.yaml \ + --external-binding-spec hs/manual/src-foreign-types/Generated/ForeignTypes/A.bindingspec.yaml \ + --create-output-dirs \ + foreign_types.h + +cabal run hs-bindgen-cli -- \ + preprocess \ + -I c/ \ + --unique-id com.hs-bindgen.manual.foreign-types \ + --hs-output-dir hs/manual/src-foreign-types \ + --module Generated.ForeignTypes \ + --external-binding-spec hs/manual/src-foreign-types/Generated/ForeignTypes/A.bindingspec.yaml \ + --external-binding-spec hs/manual/src-foreign-types/Generated/ForeignTypes/B.bindingspec.yaml \ + --create-output-dirs \ + foreign_types.h + echo "# " echo "# External bindings: vector example" echo "# " diff --git a/manual/hs/manual/manual.cabal b/manual/hs/manual/manual.cabal index 18d43acee..45672597c 100644 --- a/manual/hs/manual/manual.cabal +++ b/manual/hs/manual/manual.cabal @@ -93,3 +93,19 @@ executable run-manual -- Avoid gcc warnings about non-NFC characters -- See ghc-options: -optc -Wno-normalized + +library foreign-types + import: lang + hs-source-dirs: src-foreign-types + other-modules: + Generated.ForeignTypes + Generated.ForeignTypes.A + Generated.ForeignTypes.B + Generated.ForeignTypes.FunPtr + Generated.ForeignTypes.Safe + Generated.ForeignTypes.Unsafe + + extra-libraries: foreign_types + build-depends: + , base + , hs-bindgen-runtime From dbe05d852d401e10a0c4c9bf95f8f57266463a98 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Mon, 1 Dec 2025 12:14:02 +0100 Subject: [PATCH 5/7] `HasBaseForeignType` class --- hs-bindgen-runtime/hs-bindgen-runtime.cabal | 1 + .../src/HsBindgen/Runtime/Block.hs | 9 +- .../HsBindgen/Runtime/HasBaseForeignType.hs | 453 ++++++++++++++++++ 3 files changed, 462 insertions(+), 1 deletion(-) create mode 100644 hs-bindgen-runtime/src/HsBindgen/Runtime/HasBaseForeignType.hs diff --git a/hs-bindgen-runtime/hs-bindgen-runtime.cabal b/hs-bindgen-runtime/hs-bindgen-runtime.cabal index 8c81c1215..3c12f0ef7 100644 --- a/hs-bindgen-runtime/hs-bindgen-runtime.cabal +++ b/hs-bindgen-runtime/hs-bindgen-runtime.cabal @@ -47,6 +47,7 @@ library HsBindgen.Runtime.ConstantArray HsBindgen.Runtime.FlexibleArrayMember HsBindgen.Runtime.FunPtr + HsBindgen.Runtime.HasBaseForeignType HsBindgen.Runtime.HasCField HsBindgen.Runtime.IncompleteArray HsBindgen.Runtime.LibC diff --git a/hs-bindgen-runtime/src/HsBindgen/Runtime/Block.hs b/hs-bindgen-runtime/src/HsBindgen/Runtime/Block.hs index 421b10cd5..8f00561cb 100644 --- a/hs-bindgen-runtime/src/HsBindgen/Runtime/Block.hs +++ b/hs-bindgen-runtime/src/HsBindgen/Runtime/Block.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE UndecidableInstances #-} + -- | Bare-bones support for blocks -- -- TODO: Ideally we would at least support @Block_copy@ and @Block_release@. @@ -7,7 +9,10 @@ module HsBindgen.Runtime.Block ( Block(..) ) where -import Foreign +import Foreign (Ptr) + +import HsBindgen.Runtime.HasBaseForeignType (HasBaseForeignType, + ViaNewtype (..)) {------------------------------------------------------------------------------- Definition @@ -27,3 +32,5 @@ import Foreign -- -- > newtype VarCounter = VarCounter (Block (CInt -> IO CInt)) newtype Block t = Block (Ptr ()) + +deriving via ViaNewtype (Ptr ()) instance HasBaseForeignType (Block t) diff --git a/hs-bindgen-runtime/src/HsBindgen/Runtime/HasBaseForeignType.hs b/hs-bindgen-runtime/src/HsBindgen/Runtime/HasBaseForeignType.hs new file mode 100644 index 000000000..8229e6396 --- /dev/null +++ b/hs-bindgen-runtime/src/HsBindgen/Runtime/HasBaseForeignType.hs @@ -0,0 +1,453 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- TODO: finish documentation, including a manual section + +module HsBindgen.Runtime.HasBaseForeignType ( + -- * Class + HasBaseForeignType + , BaseForeignType + , toBaseForeignType + , fromBaseForeignType + -- * Deriving-via + , ViaNewtype(..) + -- * Re-exports + -- + -- These re-exports include all types that the + -- "HsBindgen.Runtime.HasBaseForeignType" module provides + -- 'HasBaseForeignType' instances for. + -- + -- TODO: replace by a catch-all import in @hs-bindgen@? + , module Reexports + ) where + +#if MIN_VERSION_base(4,17,0) +import Prelude (type (~)) +#endif + +import Prelude (Show, Eq, IO, ($), fmap, (.)) +import Prelude as Reexports (Char, Int, Double, Float, Bool, Word) +import Data.Int as Reexports (Int16, Int32, Int64, Int8) +import Data.Kind (Type) +import Data.Void (Void) +import Data.Word as Reexports (Word16, Word32, Word64, Word8) +import Foreign.C.Error as Reexports (Errno (..)) +import Foreign.C.Types as Reexports (CBool (..), CChar (..), CClock (..), CDouble (..), + CFloat (..), CInt (..), CIntMax (..), CIntPtr (..), + CLLong (..), CLong (..), CPtrdiff (..), CSChar (..), + CSUSeconds (..), CShort (..), CSigAtomic (..), + CSize (..), CTime (..), CUChar (..), CUInt (..), + CUIntMax (..), CUIntPtr (..), CULLong (..), CULong (..), + CUSeconds (..), CUShort (..), CWchar (..)) +import Foreign.Ptr (castFunPtr, castPtr) +import Foreign.Ptr as Reexports (FunPtr, IntPtr (..), Ptr, WordPtr (..)) +import Foreign.StablePtr (castPtrToStablePtr, castStablePtrToPtr) +import Foreign.StablePtr as Reexports (StablePtr) + +#if MIN_VERSION_base(4, 18, 0) +import Data.Coerce (coerce) +import Foreign.C.ConstPtr as Reexports (ConstPtr (..)) +#endif + +{------------------------------------------------------------------------------- + Class +-------------------------------------------------------------------------------} + +-- | The 'HasBaseForeignType' class broadly captures Haskell types that can be +-- converted to and from a /base foreign type/. +-- +-- A base foreign type is similar to a /foreign type/, but with all newtypes +-- removed. Foreign types are the kinds of types that are allowed in @foreign +-- import@ declarations. +-- +-- Some laws apply to this class: +-- +-- * If @x :: a@ is a foreign type, then @toBaseForeignType x :: BaseForeignType +-- a@ is also a valid foreign type and contains no newtypes. +-- * If @x :: BaseForeignType a@ is a foreign type, then @fromBaseForeignType x +-- :: a@ is also a valid foreign type. +-- +-- Note in particular that this does /not/ guarantee that: +-- * Every type @a@ that is an instance of 'HasBaseForeignType' is a valid +-- foreign type +-- * Every type @'BaseForeignType' a@ is a valid foreign type. +-- +-- Informally, 'toBaseForeignType' and 'fromBaseForeignType' preserve +-- /valid-foreign-type-ness/. +-- +-- === User-supplied instances +-- +-- Generally as a rule of thumb, if @a@ is a valid foreign type, then there +-- should be a sensible 'HasBaseForeignType' instance. Instances are provided in +-- this module for most basic type constructors, like '(->)', 'IO', '()', and +-- all eligible types from the "Foreign" module hierarchy. However, we can't +-- magically generate instance for user-defined newtypes, nor do we try to +-- generate instances for all newtypes from the @base@ package or other core +-- packages. Instead, the user should derive such instances either using +-- newtype-deriving or using deriving-via with the 'ViaNewtype' helper datatype. +-- Regardless of the deriving method, the @UndecidableInstances@ language +-- extension should also be enabled. +-- +-- === Foreign types +-- +-- Foreign types and its sub-kinds are described by the the "Haskell 2010 Language" +-- report. Kinds of foreign types include: +-- +-- * top-level /foreign types/ +-- * /basic foreign types/ +-- * /marshallable foreign result types/ +-- * /marshallable foreign types/ +-- +-- See the "8.4.2 Foreign Types" section of the report for more information: +-- +-- +class HasBaseForeignType a where + type ToBaseForeignKind a :: BaseForeignKind + toBaseType :: a -> BaseForeignType a + fromBaseType :: BaseForeignType a -> a + +type BaseForeignType a = FromBaseForeignKind (ToBaseForeignKind a) + +{-# INLINE toBaseForeignType #-} +-- | Convert a foreign type to its base foreign type. +-- +-- See the 'HasBaseForeignType' class for more information +toBaseForeignType :: HasBaseForeignType a => a -> BaseForeignType a +toBaseForeignType = toBaseType + +{-# INLINE fromBaseForeignType #-} +-- | Convert a base foreign type to a foreign type. +-- +-- See the 'HasBaseForeignType' class for more information +fromBaseForeignType :: HasBaseForeignType a => BaseForeignType a -> a +fromBaseForeignType = fromBaseType + +data BaseForeignKind = + -- === Foreign types === + FT_FunArrow BaseForeignKind BaseForeignKind + + -- === Marshallable foreign result types === + | FRT_Unit + | FRT_IO BaseForeignKind + + -- === Marshallable foreign types === + -- Prelude + | FAT_Char + | FAT_Int + | FAT_Double + | FAT_Float + | FAT_Bool + -- Data.Int + | FAT_Int8 + | FAT_Int16 + | FAT_Int32 + | FAT_Int64 + -- Data.Word + | FAT_Word + | FAT_Word8 + | FAT_Word16 + | FAT_Word32 + | FAT_Word64 + -- Foreign.Ptr + | FAT_Ptr + | FAT_FunPtr + | FAT_IntPtr + | FAT_WordPtr + -- Foreign.StablePtr + | FAT_StablePtr +#if MIN_VERSION_base(4, 18, 0) + -- Foreign.C.ConstPtr + | FAT_ConstPtr +#endif + -- Foreign.C.Types + | FAT_CChar + | FAT_CSChar + | FAT_CUChar + | FAT_CShort + | FAT_CUShort + | FAT_CInt + | FAT_CUInt + | FAT_CLong + | FAT_CULong + | FAT_CPtrdiff + | FAT_CSize + | FAT_CWchar + | FAT_CSigAtomic + | FAT_CLLong + | FAT_CULLong + | FAT_CBool + | FAT_CIntPtr + | FAT_CUIntPtr + | FAT_CIntMax + | FAT_CUIntMax + -- Foreign.C.Types : Numeric types + | FAT_CClock + | FAT_CTime + | FAT_CUSeconds + | FAT_CSUSeconds + -- Foreign.C.Types : Floating type + | FAT_CFloat + | FAT_CDouble + deriving stock (Show, Eq) + +type FromBaseForeignKind :: BaseForeignKind -> Type +type family FromBaseForeignKind ft where + -- === Foreign types === + FromBaseForeignKind (FT_FunArrow a b) = FromBaseForeignKind a -> FromBaseForeignKind b + + -- === Marshallable foreign result types === + FromBaseForeignKind FRT_Unit = () + FromBaseForeignKind (FRT_IO a) = IO (FromBaseForeignKind a) + + -- === Marshallable foreign types === + -- Prelude + FromBaseForeignKind FAT_Char = Char + FromBaseForeignKind FAT_Int = Int + FromBaseForeignKind FAT_Double = Double + FromBaseForeignKind FAT_Float = Float + FromBaseForeignKind FAT_Bool = Bool + -- Data.Int + FromBaseForeignKind FAT_Int8 = Int8 + FromBaseForeignKind FAT_Int16 = Int16 + FromBaseForeignKind FAT_Int32 = Int32 + FromBaseForeignKind FAT_Int64 = Int64 + -- Data.Word + FromBaseForeignKind FAT_Word = Word + FromBaseForeignKind FAT_Word8 = Word8 + FromBaseForeignKind FAT_Word16 = Word16 + FromBaseForeignKind FAT_Word32 = Word32 + FromBaseForeignKind FAT_Word64 = Word64 + -- Foreign.Ptr + FromBaseForeignKind FAT_Ptr = Ptr Void + FromBaseForeignKind FAT_FunPtr = FunPtr Void + FromBaseForeignKind FAT_IntPtr = IntPtr + FromBaseForeignKind FAT_WordPtr = WordPtr + -- Foreign.StablePtr + FromBaseForeignKind FAT_StablePtr = StablePtr Void +#if MIN_VERSION_base(4, 18, 0) + -- Foreign.C.ConstPtr + FromBaseForeignKind FAT_ConstPtr = ConstPtr Void +#endif + -- Foreign.C.Types + FromBaseForeignKind FAT_CChar = CChar + FromBaseForeignKind FAT_CSChar = CSChar + FromBaseForeignKind FAT_CUChar = CUChar + FromBaseForeignKind FAT_CShort = CShort + FromBaseForeignKind FAT_CUShort = CUShort + FromBaseForeignKind FAT_CInt = CInt + FromBaseForeignKind FAT_CUInt = CUInt + FromBaseForeignKind FAT_CLong = CLong + FromBaseForeignKind FAT_CULong = CULong + FromBaseForeignKind FAT_CPtrdiff = CPtrdiff + FromBaseForeignKind FAT_CSize = CSize + FromBaseForeignKind FAT_CWchar = CWchar + FromBaseForeignKind FAT_CSigAtomic = CSigAtomic + FromBaseForeignKind FAT_CLLong = CLLong + FromBaseForeignKind FAT_CULLong = CULLong + FromBaseForeignKind FAT_CBool = CBool + FromBaseForeignKind FAT_CIntPtr = CIntPtr + FromBaseForeignKind FAT_CUIntPtr = CUIntPtr + FromBaseForeignKind FAT_CIntMax = CIntMax + FromBaseForeignKind FAT_CUIntMax = CUIntMax + -- Foreign.C.Types : Numeric types + FromBaseForeignKind FAT_CClock = CClock + FromBaseForeignKind FAT_CTime = CTime + FromBaseForeignKind FAT_CUSeconds = CUSeconds + FromBaseForeignKind FAT_CSUSeconds = CSUSeconds + -- Foreign.C.Types : Floating type + FromBaseForeignKind FAT_CFloat = CFloat + FromBaseForeignKind FAT_CDouble = CDouble + +{------------------------------------------------------------------------------- + Deriving-via +-------------------------------------------------------------------------------} + +-- === Via newtype === + +type ViaNewtype :: Type -> Type +newtype ViaNewtype a = ViaNewtype a + +-- | This produces almost the same instance as you would get using @deriving +-- newtype@, but /this/ instance has explicit @INLINE@ pragmas. +instance HasBaseForeignType a => HasBaseForeignType (ViaNewtype a) where + type ToBaseForeignKind (ViaNewtype a) = ToBaseForeignKind a + {-# INLINE toBaseType #-} + toBaseType (ViaNewtype x) = toBaseType x + {-# INLINE fromBaseType #-} + fromBaseType x = ViaNewtype (fromBaseType x) + +-- === Via a base type === + +type ViaBaseForeignKind :: k -> Type -> Type +newtype ViaBaseForeignKind k a = ViaBaseForeignKind a + +instance FromBaseForeignKind fat ~ a => HasBaseForeignType (ViaBaseForeignKind fat a) where + type ToBaseForeignKind (ViaBaseForeignKind fat a) = fat + {-# INLINE toBaseType #-} + toBaseType (ViaBaseForeignKind x) = x + {-# INLINE fromBaseType #-} + fromBaseType x = ViaBaseForeignKind x + +{------------------------------------------------------------------------------- + Foreign types +-------------------------------------------------------------------------------} + +instance (HasBaseForeignType a, HasBaseForeignType b) => HasBaseForeignType (a -> b) where + type ToBaseForeignKind (a -> b) = FT_FunArrow (ToBaseForeignKind a) (ToBaseForeignKind b) + {-# INLINE toBaseType #-} + toBaseType f = \x -> toBaseType (f $ fromBaseType x) + {-# INLINE fromBaseType #-} + fromBaseType f = \x -> fromBaseType (f $ toBaseType x) + +{------------------------------------------------------------------------------- + Marshallable foreign result types +-------------------------------------------------------------------------------} + +deriving via ViaBaseForeignKind FRT_Unit () instance HasBaseForeignType () + +instance HasBaseForeignType a => HasBaseForeignType (IO a) where + type ToBaseForeignKind (IO ( a)) = FRT_IO (ToBaseForeignKind a) + {-# INLINE toBaseType #-} + toBaseType = fmap toBaseType + {-# INLINE fromBaseType #-} + fromBaseType = fmap fromBaseType + +{------------------------------------------------------------------------------- + Marshallable foreign types +-------------------------------------------------------------------------------} + +-- NOTE: we use 'ViaBaseForeignKind' rather than 'ViaNewtype' to derive +-- 'HasBaseForeignType' instances even for non-basic foreign types coming from the +-- "Foreign.C" modules. Most of these types, like 'CInt', are newtypes around +-- basic foreign types, but the specific basic foreign type depends on the +-- platform\/operating system. + +-- === Prelude === + +-- == Basic foreign types == + +deriving via ViaBaseForeignKind FAT_Char Char instance HasBaseForeignType Char +deriving via ViaBaseForeignKind FAT_Int Int instance HasBaseForeignType Int +deriving via ViaBaseForeignKind FAT_Double Double instance HasBaseForeignType Double +deriving via ViaBaseForeignKind FAT_Float Float instance HasBaseForeignType Float +deriving via ViaBaseForeignKind FAT_Bool Bool instance HasBaseForeignType Bool + +-- === Data.Int === + +-- == Basic foreign types == + +deriving via ViaBaseForeignKind FAT_Int8 Int8 instance HasBaseForeignType Int8 +deriving via ViaBaseForeignKind FAT_Int16 Int16 instance HasBaseForeignType Int16 +deriving via ViaBaseForeignKind FAT_Int32 Int32 instance HasBaseForeignType Int32 +deriving via ViaBaseForeignKind FAT_Int64 Int64 instance HasBaseForeignType Int64 + +-- === Data.Word === + +-- == Basic foreign types == + +deriving via ViaBaseForeignKind FAT_Word Word instance HasBaseForeignType Word +deriving via ViaBaseForeignKind FAT_Word8 Word8 instance HasBaseForeignType Word8 +deriving via ViaBaseForeignKind FAT_Word16 Word16 instance HasBaseForeignType Word16 +deriving via ViaBaseForeignKind FAT_Word32 Word32 instance HasBaseForeignType Word32 +deriving via ViaBaseForeignKind FAT_Word64 Word64 instance HasBaseForeignType Word64 + +-- === Foreign.Ptr === + +-- == Basic foreign types == + +instance HasBaseForeignType (Ptr a) where + type ToBaseForeignKind (Ptr a) = FAT_Ptr + {-# INLINE toBaseType #-} + toBaseType = castPtr + {-# INLINE fromBaseType #-} + fromBaseType = castPtr + +instance HasBaseForeignType (FunPtr a) where + type ToBaseForeignKind (FunPtr a) = FAT_FunPtr + {-# INLINE toBaseType #-} + toBaseType = castFunPtr + {-# INLINE fromBaseType #-} + fromBaseType = castFunPtr + +-- == Newtypes around basic foreign types == + +deriving via ViaBaseForeignKind FAT_IntPtr IntPtr instance HasBaseForeignType IntPtr +deriving via ViaBaseForeignKind FAT_WordPtr WordPtr instance HasBaseForeignType WordPtr + +-- === Foreign.StablePtr === + +-- == Basic foreign types == + +instance HasBaseForeignType (StablePtr a) where + type ToBaseForeignKind (StablePtr a) = FAT_StablePtr + {-# INLINE toBaseType #-} + toBaseType = castStablePtr + {-# INLINE fromBaseType #-} + fromBaseType = castStablePtr + +{-# INLINE castStablePtr #-} +castStablePtr :: StablePtr a -> StablePtr b +castStablePtr = castPtrToStablePtr . castStablePtrToPtr + +#if MIN_VERSION_base(4, 18, 0) +-- === Foreign.C.ConstPtr === + +-- == Newtypes around basic foreign types == + +instance HasBaseForeignType (ConstPtr a) where + type ToBaseForeignKind (ConstPtr a) = FAT_ConstPtr + {-# INLINE toBaseType #-} + toBaseType = coerce castPtr + {-# INLINE fromBaseType #-} + fromBaseType = coerce castPtr +#endif + +-- === Foreign.C.Error === + +-- == Newtypes around basic foreign types == + +deriving via ViaNewtype CInt instance HasBaseForeignType Errno + +-- === Foreign.C.Types === + +-- == Newtypes around basic foreign types == + +deriving via ViaBaseForeignKind FAT_CChar CChar instance HasBaseForeignType CChar +deriving via ViaBaseForeignKind FAT_CSChar CSChar instance HasBaseForeignType CSChar +deriving via ViaBaseForeignKind FAT_CUChar CUChar instance HasBaseForeignType CUChar +deriving via ViaBaseForeignKind FAT_CShort CShort instance HasBaseForeignType CShort +deriving via ViaBaseForeignKind FAT_CUShort CUShort instance HasBaseForeignType CUShort +deriving via ViaBaseForeignKind FAT_CInt CInt instance HasBaseForeignType CInt +deriving via ViaBaseForeignKind FAT_CUInt CUInt instance HasBaseForeignType CUInt +deriving via ViaBaseForeignKind FAT_CLong CLong instance HasBaseForeignType CLong +deriving via ViaBaseForeignKind FAT_CULong CULong instance HasBaseForeignType CULong +deriving via ViaBaseForeignKind FAT_CPtrdiff CPtrdiff instance HasBaseForeignType CPtrdiff +deriving via ViaBaseForeignKind FAT_CSize CSize instance HasBaseForeignType CSize +deriving via ViaBaseForeignKind FAT_CWchar CWchar instance HasBaseForeignType CWchar +deriving via ViaBaseForeignKind FAT_CSigAtomic CSigAtomic instance HasBaseForeignType CSigAtomic +deriving via ViaBaseForeignKind FAT_CLLong CLLong instance HasBaseForeignType CLLong +deriving via ViaBaseForeignKind FAT_CULLong CULLong instance HasBaseForeignType CULLong +deriving via ViaBaseForeignKind FAT_CBool CBool instance HasBaseForeignType CBool +deriving via ViaBaseForeignKind FAT_CIntPtr CIntPtr instance HasBaseForeignType CIntPtr +deriving via ViaBaseForeignKind FAT_CUIntPtr CUIntPtr instance HasBaseForeignType CUIntPtr +deriving via ViaBaseForeignKind FAT_CIntMax CIntMax instance HasBaseForeignType CIntMax +deriving via ViaBaseForeignKind FAT_CUIntMax CUIntMax instance HasBaseForeignType CUIntMax + +-- === Foreign.C.Types : Numeric types === + +-- == Newtypes around basic foreign types == + +deriving via ViaBaseForeignKind FAT_CClock CClock instance HasBaseForeignType CClock +deriving via ViaBaseForeignKind FAT_CTime CTime instance HasBaseForeignType CTime +deriving via ViaBaseForeignKind FAT_CUSeconds CUSeconds instance HasBaseForeignType CUSeconds +deriving via ViaBaseForeignKind FAT_CSUSeconds CSUSeconds instance HasBaseForeignType CSUSeconds + +-- === Foreign.C.Types : Floating types === + +-- == Newtypes around basic foreign types == + +deriving via ViaBaseForeignKind FAT_CFloat CFloat instance HasBaseForeignType CFloat +deriving via ViaBaseForeignKind FAT_CDouble CDouble instance HasBaseForeignType CDouble + From 60fe845af7bf8ebffb7a485663069fc2accc60aa Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Mon, 1 Dec 2025 16:44:06 +0100 Subject: [PATCH 6/7] Generate `HasBaseForeignType` instances --- .../attributes/type_attributes/Example.hs | 7 +- .../type_attributes/bindingspec.yaml | 3 + .../attributes/type_attributes/th.txt | 3 + .../bs_ext_target_any/Example.hs | 3 +- .../bs_ext_target_any/bindingspec.yaml | 1 + .../binding-specs/bs_ext_target_any/th.txt | 1 + .../binding-specs/bs_pre_omit_type/Example.hs | 3 +- .../bs_pre_omit_type/bindingspec.yaml | 1 + .../binding-specs/bs_pre_omit_type/th.txt | 1 + .../bs_pre_rename_type/Example.hs | 3 +- .../bs_pre_rename_type/bindingspec.yaml | 1 + .../binding-specs/bs_pre_rename_type/th.txt | 1 + .../Example.hs | 4 +- .../bindingspec.yaml | 1 + .../declarations_required_for_scoping/th.txt | 1 + .../declarations/redeclaration/Example.hs | 3 +- .../redeclaration/bindingspec.yaml | 1 + .../declarations/redeclaration/th.txt | 1 + .../declarations/select_scoping/Example.hs | 3 +- .../select_scoping/bindingspec.yaml | 1 + .../declarations/select_scoping/th.txt | 1 + .../documentation/doxygen_docs/Example.hs | 11 ++- .../doxygen_docs/bindingspec.yaml | 9 +++ .../documentation/doxygen_docs/th.txt | 9 ++- .../fixtures/edge-cases/adios/Example.hs | 5 +- .../edge-cases/adios/bindingspec.yaml | 2 + hs-bindgen/fixtures/edge-cases/adios/th.txt | 2 + .../edge-cases/distilled_lib_1/Example.hs | 10 ++- .../distilled_lib_1/bindingspec.yaml | 7 ++ .../edge-cases/distilled_lib_1/th.txt | 7 +- .../fixtures/edge-cases/iterator/Example.hs | 5 ++ .../edge-cases/iterator/bindingspec.yaml | 6 ++ .../fixtures/edge-cases/iterator/th.txt | 3 + .../edge-cases/spec_examples/Example.hs | 7 +- .../edge-cases/spec_examples/bindingspec.yaml | 3 + .../fixtures/edge-cases/spec_examples/th.txt | 3 + .../fixtures/edge-cases/uses_utf8/Example.hs | 4 ++ .../edge-cases/uses_utf8/bindingspec.yaml | 1 + .../fixtures/edge-cases/uses_utf8/th.txt | 1 + .../fixtures/functions/callbacks/Example.hs | 22 +++--- .../functions/callbacks/bindingspec.yaml | 17 +++++ .../fixtures/functions/callbacks/th.txt | 19 +++-- .../circular_dependency_fun/Example.hs | 4 +- .../circular_dependency_fun/bindingspec.yaml | 3 + .../functions/circular_dependency_fun/th.txt | 3 +- .../functions/fun_attributes/Example.hs | 3 +- .../functions/fun_attributes/bindingspec.yaml | 1 + .../fixtures/functions/fun_attributes/th.txt | 1 + .../fixtures/globals/globals/Example.hs | 3 +- .../fixtures/globals/globals/bindingspec.yaml | 1 + hs-bindgen/fixtures/globals/globals/th.txt | 1 + .../macros/macro_in_fundecl/Example.hs | 12 ++-- .../macros/macro_in_fundecl/bindingspec.yaml | 5 ++ .../fixtures/macros/macro_in_fundecl/th.txt | 5 ++ .../macro_in_fundecl_vs_typedef/Example.hs | 5 +- .../bindingspec.yaml | 2 + .../macros/macro_in_fundecl_vs_typedef/th.txt | 2 + .../macros/macro_redefines_global/Example.hs | 3 +- .../macro_redefines_global/bindingspec.yaml | 1 + .../macros/macro_redefines_global/th.txt | 1 + .../macros/macro_typedef_scope/Example.hs | 9 +-- .../macro_typedef_scope/bindingspec.yaml | 4 ++ .../macros/macro_typedef_scope/th.txt | 4 ++ .../macros/macro_typedef_struct/Example.hs | 3 +- .../macro_typedef_struct/bindingspec.yaml | 1 + .../macros/macro_typedef_struct/th.txt | 1 + .../fixtures/macros/macro_types/Example.hs | 15 ++-- .../macros/macro_types/bindingspec.yaml | 7 ++ hs-bindgen/fixtures/macros/macro_types/th.txt | 9 ++- hs-bindgen/fixtures/macros/reparse/Example.hs | 70 +++++++++++-------- .../fixtures/macros/reparse/bindingspec.yaml | 53 ++++++++++++++ hs-bindgen/fixtures/macros/reparse/th.txt | 62 ++++++++++------ .../manual/function_pointers/Example.hs | 3 + .../manual/function_pointers/bindingspec.yaml | 2 + .../fixtures/manual/function_pointers/th.txt | 1 + .../fixtures/manual/zero_copy/Example.hs | 3 +- .../manual/zero_copy/bindingspec.yaml | 1 + hs-bindgen/fixtures/manual/zero_copy/th.txt | 1 + .../program_slicing_selection/Example.hs | 3 + .../bindingspec.yaml | 1 + .../program_slicing_selection/th.txt | 1 + .../program_slicing_simple/Example.hs | 3 +- .../program_slicing_simple/bindingspec.yaml | 1 + .../program_slicing_simple/th.txt | 1 + .../types/enums/enum_cpp_syntax/Example.hs | 4 ++ .../enums/enum_cpp_syntax/bindingspec.yaml | 1 + .../types/enums/enum_cpp_syntax/th.txt | 1 + .../fixtures/types/enums/enums/Example.hs | 12 ++++ .../types/enums/enums/bindingspec.yaml | 9 +++ hs-bindgen/fixtures/types/enums/enums/th.txt | 9 +++ .../types/enums/nested_enums/Example.hs | 4 ++ .../types/enums/nested_enums/bindingspec.yaml | 2 + .../fixtures/types/enums/nested_enums/th.txt | 2 + .../fixtures/types/primitives/bool/Example.hs | 3 +- .../types/primitives/bool/bindingspec.yaml | 1 + .../fixtures/types/primitives/bool/th.txt | 1 + .../types/structs/simple_structs/Example.hs | 5 +- .../structs/simple_structs/bindingspec.yaml | 2 + .../types/structs/simple_structs/th.txt | 4 +- .../typedefs/typedef_analysis/Example.hs | 5 +- .../typedef_analysis/bindingspec.yaml | 2 + .../types/typedefs/typedef_analysis/th.txt | 4 +- .../typedefs/typedef_vs_macro/Example.hs | 13 ++-- .../typedef_vs_macro/bindingspec.yaml | 6 ++ .../types/typedefs/typedef_vs_macro/th.txt | 7 +- .../types/typedefs/typedefs/Example.hs | 20 ++++-- .../types/typedefs/typedefs/bindingspec.yaml | 20 ++++++ .../fixtures/types/typedefs/typedefs/th.txt | 18 +++-- .../types/typedefs/typenames/Example.hs | 5 +- .../types/typedefs/typenames/bindingspec.yaml | 1 + .../fixtures/types/typedefs/typenames/th.txt | 2 + .../HsBindgen/Backend/Extensions.hs | 1 + .../HsBindgen/Backend/Hs/Translation.hs | 20 ++++-- .../Backend/Hs/Translation/ForeignImport.hs | 21 +++++- .../Backend/Hs/Translation/Instances.hs | 19 ++++- .../HsBindgen/Backend/HsModule/Names.hs | 4 ++ .../src-internal/HsBindgen/Backend/SHs/AST.hs | 3 + .../HsBindgen/Backend/SHs/Translation.hs | 41 +++++------ .../HsBindgen/Backend/TH/Translation.hs | 7 ++ .../HsBindgen/BindingSpec/Private/Stdlib.hs | 2 + .../HsBindgen/Language/Haskell.hs | 1 + 121 files changed, 620 insertions(+), 174 deletions(-) diff --git a/hs-bindgen/fixtures/attributes/type_attributes/Example.hs b/hs-bindgen/fixtures/attributes/type_attributes/Example.hs index 1cc5deec5..6564493a4 100644 --- a/hs-bindgen/fixtures/attributes/type_attributes/Example.hs +++ b/hs-bindgen/fixtures/attributes/type_attributes/Example.hs @@ -25,6 +25,7 @@ import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.ByteArray import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.SizedByteArray import Data.Bits (FiniteBits) @@ -89,7 +90,7 @@ newtype More_aligned_int = More_aligned_int { un_More_aligned_int :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType More_aligned_int) "un_More_aligned_int") ) => GHC.Records.HasField "un_More_aligned_int" (Ptr.Ptr More_aligned_int) (Ptr.Ptr ty) where @@ -422,7 +423,7 @@ newtype T1 = T1 { un_T1 :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType T1) "un_T1") ) => GHC.Records.HasField "un_T1" (Ptr.Ptr T1) (Ptr.Ptr ty) where @@ -446,7 +447,7 @@ newtype Short_a = Short_a { un_Short_a :: FC.CShort } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Short_a) "un_Short_a") ) => GHC.Records.HasField "un_Short_a" (Ptr.Ptr Short_a) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/attributes/type_attributes/bindingspec.yaml b/hs-bindgen/fixtures/attributes/type_attributes/bindingspec.yaml index caf32532b..11eb9457d 100644 --- a/hs-bindgen/fixtures/attributes/type_attributes/bindingspec.yaml +++ b/hs-bindgen/fixtures/attributes/type_attributes/bindingspec.yaml @@ -39,6 +39,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -74,6 +75,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -89,6 +91,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/attributes/type_attributes/th.txt b/hs-bindgen/fixtures/attributes/type_attributes/th.txt index fcbc55ae1..fe698e138 100644 --- a/hs-bindgen/fixtures/attributes/type_attributes/th.txt +++ b/hs-bindgen/fixtures/attributes/type_attributes/th.txt @@ -48,6 +48,7 @@ newtype More_aligned_int -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -331,6 +332,7 @@ newtype T1 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -361,6 +363,7 @@ newtype Short_a -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/Example.hs b/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/Example.hs index 97257f940..45d0d2eb5 100644 --- a/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/Example.hs +++ b/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype Sym = Sym { un_Sym :: FC.CChar } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Sym) "un_Sym") ) => GHC.Records.HasField "un_Sym" (Ptr.Ptr Sym) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/bindingspec.yaml b/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/bindingspec.yaml index 6d1ed4369..e1930a178 100644 --- a/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/bindingspec.yaml +++ b/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/bindingspec.yaml @@ -15,6 +15,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/th.txt b/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/th.txt index af36a304d..6b91ccb52 100644 --- a/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/th.txt +++ b/hs-bindgen/fixtures/binding-specs/bs_ext_target_any/th.txt @@ -15,6 +15,7 @@ newtype Sym -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/Example.hs b/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/Example.hs index fdae80f79..af6ce915a 100644 --- a/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/Example.hs +++ b/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype Sym = Sym { un_Sym :: FC.CChar } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Sym) "un_Sym") ) => GHC.Records.HasField "un_Sym" (Ptr.Ptr Sym) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/bindingspec.yaml b/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/bindingspec.yaml index ccaad0fa9..ec9906cc7 100644 --- a/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/bindingspec.yaml +++ b/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/bindingspec.yaml @@ -18,6 +18,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/th.txt b/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/th.txt index fc815dfcb..4a928757f 100644 --- a/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/th.txt +++ b/hs-bindgen/fixtures/binding-specs/bs_pre_omit_type/th.txt @@ -15,6 +15,7 @@ newtype Sym -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/Example.hs b/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/Example.hs index 9b17e07f9..ca94b4d80 100644 --- a/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/Example.hs +++ b/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype MySym = MySym { un_MySym :: FC.CChar } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType MySym) "un_MySym") ) => GHC.Records.HasField "un_MySym" (Ptr.Ptr MySym) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/bindingspec.yaml b/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/bindingspec.yaml index 512652501..a9fd0b11d 100644 --- a/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/bindingspec.yaml +++ b/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/bindingspec.yaml @@ -15,6 +15,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/th.txt b/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/th.txt index 71cfc6890..7d72ac568 100644 --- a/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/th.txt +++ b/hs-bindgen/fixtures/binding-specs/bs_pre_rename_type/th.txt @@ -15,6 +15,7 @@ newtype MySym -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example.hs b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example.hs index 0bfe1f8e5..b39b331b9 100644 --- a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example.hs +++ b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example.hs @@ -1,12 +1,14 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UndecidableInstances #-} module Example where import qualified Data.Bits as Bits import qualified Data.Ix as Ix import qualified Foreign as F +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Bits (FiniteBits) import Prelude (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show) @@ -21,4 +23,4 @@ newtype A = A { un_A :: HsBindgen.Runtime.Prelude.CSize } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) diff --git a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/bindingspec.yaml b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/bindingspec.yaml index 7ddbab7b0..bd220127f 100644 --- a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/bindingspec.yaml +++ b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/bindingspec.yaml @@ -15,6 +15,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/th.txt b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/th.txt index b5d3027ae..8938d66f5 100644 --- a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/th.txt +++ b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/th.txt @@ -38,6 +38,7 @@ newtype A -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/declarations/redeclaration/Example.hs b/hs-bindgen/fixtures/declarations/redeclaration/Example.hs index b6018fa95..0c3b3f0f3 100644 --- a/hs-bindgen/fixtures/declarations/redeclaration/Example.hs +++ b/hs-bindgen/fixtures/declarations/redeclaration/Example.hs @@ -24,6 +24,7 @@ import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.ByteArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.SizedByteArray import Data.Bits (FiniteBits) @@ -40,7 +41,7 @@ newtype Int_t = Int_t { un_Int_t :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Int_t) "un_Int_t") ) => GHC.Records.HasField "un_Int_t" (Ptr.Ptr Int_t) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/declarations/redeclaration/bindingspec.yaml b/hs-bindgen/fixtures/declarations/redeclaration/bindingspec.yaml index 67aab41ea..6c86b743b 100644 --- a/hs-bindgen/fixtures/declarations/redeclaration/bindingspec.yaml +++ b/hs-bindgen/fixtures/declarations/redeclaration/bindingspec.yaml @@ -24,6 +24,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/declarations/redeclaration/th.txt b/hs-bindgen/fixtures/declarations/redeclaration/th.txt index 2ec76d00f..8a8c0e1d5 100644 --- a/hs-bindgen/fixtures/declarations/redeclaration/th.txt +++ b/hs-bindgen/fixtures/declarations/redeclaration/th.txt @@ -22,6 +22,7 @@ newtype Int_t -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/declarations/select_scoping/Example.hs b/hs-bindgen/fixtures/declarations/select_scoping/Example.hs index 56c7ff4dc..740426e3a 100644 --- a/hs-bindgen/fixtures/declarations/select_scoping/Example.hs +++ b/hs-bindgen/fixtures/declarations/select_scoping/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype ParsedAndSelected1 = ParsedAndSelected1 { un_ParsedAndSelected1 :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType ParsedAndSelected1) "un_ParsedAndSelected1") ) => GHC.Records.HasField "un_ParsedAndSelected1" (Ptr.Ptr ParsedAndSelected1) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/declarations/select_scoping/bindingspec.yaml b/hs-bindgen/fixtures/declarations/select_scoping/bindingspec.yaml index 499aa38c3..f2d796edc 100644 --- a/hs-bindgen/fixtures/declarations/select_scoping/bindingspec.yaml +++ b/hs-bindgen/fixtures/declarations/select_scoping/bindingspec.yaml @@ -15,6 +15,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/declarations/select_scoping/th.txt b/hs-bindgen/fixtures/declarations/select_scoping/th.txt index 6bb02613b..298c2bcd0 100644 --- a/hs-bindgen/fixtures/declarations/select_scoping/th.txt +++ b/hs-bindgen/fixtures/declarations/select_scoping/th.txt @@ -16,6 +16,7 @@ newtype ParsedAndSelected1 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/documentation/doxygen_docs/Example.hs b/hs-bindgen/fixtures/documentation/doxygen_docs/Example.hs index 6940bed38..b143c7353 100644 --- a/hs-bindgen/fixtures/documentation/doxygen_docs/Example.hs +++ b/hs-bindgen/fixtures/documentation/doxygen_docs/Example.hs @@ -32,6 +32,7 @@ import qualified HsBindgen.Runtime.CEnum import qualified HsBindgen.Runtime.ConstantArray import qualified HsBindgen.Runtime.FlexibleArrayMember import qualified HsBindgen.Runtime.FunPtr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.Prelude import qualified HsBindgen.Runtime.SizedByteArray @@ -66,7 +67,7 @@ newtype Size_type = Size_type { un_Size_type :: HsBindgen.Runtime.Prelude.CSize } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Size_type) "un_Size_type") ) => GHC.Records.HasField "un_Size_type" (Ptr.Ptr Size_type) (Ptr.Ptr ty) where @@ -121,6 +122,7 @@ newtype Color_enum = Color_enum { un_Color_enum :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Color_enum where @@ -225,6 +227,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ newtype Event_callback_t_Deref = Event_callback_t_Deref { un_Event_callback_t_Deref :: FC.CInt -> (Ptr.Ptr Void) -> IO FC.CInt } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toEvent_callback_t_Deref :: Event_callback_t_Deref @@ -275,7 +278,7 @@ newtype Event_callback_t = Event_callback_t { un_Event_callback_t :: Ptr.FunPtr Event_callback_t_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Event_callback_t) "un_Event_callback_t") ) => GHC.Records.HasField "un_Event_callback_t" (Ptr.Ptr Event_callback_t) (Ptr.Ptr ty) where @@ -471,6 +474,7 @@ newtype Status_code_t = Status_code_t { un_Status_code_t :: FC.CInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Status_code_t where @@ -1013,6 +1017,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ newtype Processor_fn_t_Deref = Processor_fn_t_Deref { un_Processor_fn_t_Deref :: FC.CInt -> (Ptr.Ptr Void) -> IO FC.CInt } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toProcessor_fn_t_Deref :: Processor_fn_t_Deref @@ -1065,7 +1070,7 @@ newtype Processor_fn_t = Processor_fn_t { un_Processor_fn_t :: Ptr.FunPtr Processor_fn_t_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Processor_fn_t) "un_Processor_fn_t") ) => GHC.Records.HasField "un_Processor_fn_t" (Ptr.Ptr Processor_fn_t) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/documentation/doxygen_docs/bindingspec.yaml b/hs-bindgen/fixtures/documentation/doxygen_docs/bindingspec.yaml index 74db40ce7..e340c80d6 100644 --- a/hs-bindgen/fixtures/documentation/doxygen_docs/bindingspec.yaml +++ b/hs-bindgen/fixtures/documentation/doxygen_docs/bindingspec.yaml @@ -58,6 +58,7 @@ hstypes: - hsname: Color_enum instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -78,10 +79,13 @@ hstypes: - hsname: Event_callback_t instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Event_callback_t_Deref + instances: + - HasBaseForeignType - hsname: Filename_t instances: - Eq @@ -97,10 +101,13 @@ hstypes: - hsname: Processor_fn_t instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Processor_fn_t_Deref + instances: + - HasBaseForeignType - hsname: Size_type instances: - Bits @@ -108,6 +115,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -119,6 +127,7 @@ hstypes: - hsname: Status_code_t instances: - Eq + - HasBaseForeignType - Ord - Read - Show diff --git a/hs-bindgen/fixtures/documentation/doxygen_docs/th.txt b/hs-bindgen/fixtures/documentation/doxygen_docs/th.txt index 9c115e304..0db69c40b 100644 --- a/hs-bindgen/fixtures/documentation/doxygen_docs/th.txt +++ b/hs-bindgen/fixtures/documentation/doxygen_docs/th.txt @@ -386,6 +386,7 @@ newtype Size_type -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -450,6 +451,7 @@ newtype Color_enum __exported by:__ @documentation\/doxygen_docs.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Color_enum where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -546,6 +548,7 @@ newtype Event_callback_t_Deref __exported by:__ @documentation\/doxygen_docs.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toEvent_callback_t_Deref :: Event_callback_t_Deref -> IO (FunPtr Event_callback_t_Deref) foreign import ccall safe "dynamic" fromEvent_callback_t_Deref :: FunPtr Event_callback_t_Deref -> @@ -600,7 +603,7 @@ newtype Event_callback_t __exported by:__ @documentation\/doxygen_docs.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Event_callback_t "un_Event_callback_t") => HasField "un_Event_callback_t" (Ptr Event_callback_t) (Ptr ty) @@ -755,6 +758,7 @@ newtype Status_code_t __exported by:__ @documentation\/doxygen_docs.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Status_code_t where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -1304,6 +1308,7 @@ newtype Processor_fn_t_Deref __exported by:__ @documentation\/doxygen_docs.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toProcessor_fn_t_Deref :: Processor_fn_t_Deref -> IO (FunPtr Processor_fn_t_Deref) foreign import ccall safe "dynamic" fromProcessor_fn_t_Deref :: FunPtr Processor_fn_t_Deref -> @@ -1361,7 +1366,7 @@ newtype Processor_fn_t __exported by:__ @documentation\/doxygen_docs.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Processor_fn_t "un_Processor_fn_t") => HasField "un_Processor_fn_t" (Ptr Processor_fn_t) (Ptr ty) where getField = ptrToCField (Proxy @"un_Processor_fn_t") diff --git a/hs-bindgen/fixtures/edge-cases/adios/Example.hs b/hs-bindgen/fixtures/edge-cases/adios/Example.hs index bf82013bd..5d93ce6f3 100644 --- a/hs-bindgen/fixtures/edge-cases/adios/Example.hs +++ b/hs-bindgen/fixtures/edge-cases/adios/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype Adio'0301s = Adio'0301s { un_Adio'0301s :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Adio'0301s) "un_Adio'0301s") ) => GHC.Records.HasField "un_Adio'0301s" (Ptr.Ptr Adio'0301s) (Ptr.Ptr ty) where @@ -58,7 +59,7 @@ newtype C数字 = C数字 { un_C数字 :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType C数字) "un_C\25968\23383") ) => GHC.Records.HasField "un_C\25968\23383" (Ptr.Ptr C数字) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/edge-cases/adios/bindingspec.yaml b/hs-bindgen/fixtures/edge-cases/adios/bindingspec.yaml index 264b56497..6c6b68b31 100644 --- a/hs-bindgen/fixtures/edge-cases/adios/bindingspec.yaml +++ b/hs-bindgen/fixtures/edge-cases/adios/bindingspec.yaml @@ -18,6 +18,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -33,6 +34,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/edge-cases/adios/th.txt b/hs-bindgen/fixtures/edge-cases/adios/th.txt index aa418f579..eb35dedba 100644 --- a/hs-bindgen/fixtures/edge-cases/adios/th.txt +++ b/hs-bindgen/fixtures/edge-cases/adios/th.txt @@ -70,6 +70,7 @@ newtype Adio'0301s -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -100,6 +101,7 @@ newtype C数字 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example.hs b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example.hs index a094cd170..6bfe9eb70 100644 --- a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example.hs +++ b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example.hs @@ -26,6 +26,7 @@ import qualified GHC.Records import qualified HsBindgen.Runtime.CEnum import qualified HsBindgen.Runtime.ConstantArray import qualified HsBindgen.Runtime.FunPtr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.Prelude import qualified Text.Read @@ -112,6 +113,7 @@ newtype Another_typedef_enum_e = Another_typedef_enum_e { un_Another_typedef_enum_e :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Another_typedef_enum_e where @@ -228,7 +230,7 @@ newtype A_type_t = A_type_t { un_A_type_t :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType A_type_t) "un_A_type_t") ) => GHC.Records.HasField "un_A_type_t" (Ptr.Ptr A_type_t) (Ptr.Ptr ty) where @@ -252,7 +254,7 @@ newtype Var_t = Var_t { un_Var_t :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Var_t) "un_Var_t") ) => GHC.Records.HasField "un_Var_t" (Ptr.Ptr Var_t) (Ptr.Ptr ty) where @@ -589,6 +591,7 @@ newtype A_typedef_enum_e = A_typedef_enum_e { un_A_typedef_enum_e :: FC.CUChar } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable A_typedef_enum_e where @@ -697,6 +700,7 @@ __exported by:__ @edge-cases\/distilled_lib_1.h@ newtype Callback_t_Deref = Callback_t_Deref { un_Callback_t_Deref :: (Ptr.Ptr Void) -> HsBindgen.Runtime.Prelude.Word32 -> IO HsBindgen.Runtime.Prelude.Word32 } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toCallback_t_Deref :: Callback_t_Deref @@ -737,7 +741,7 @@ newtype Callback_t = Callback_t { un_Callback_t :: Ptr.FunPtr Callback_t_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Callback_t) "un_Callback_t") ) => GHC.Records.HasField "un_Callback_t" (Ptr.Ptr Callback_t) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/bindingspec.yaml b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/bindingspec.yaml index 05ebbcc31..ee900b971 100644 --- a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/bindingspec.yaml +++ b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/bindingspec.yaml @@ -36,6 +36,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -47,6 +48,7 @@ hstypes: - hsname: A_typedef_enum_e instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -59,6 +61,7 @@ hstypes: - hsname: Another_typedef_enum_e instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -71,10 +74,13 @@ hstypes: - hsname: Callback_t instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Callback_t_Deref + instances: + - HasBaseForeignType - hsname: Var_t instances: - Bits @@ -82,6 +88,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/th.txt b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/th.txt index 60054e50b..a93519df2 100644 --- a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/th.txt +++ b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/th.txt @@ -102,6 +102,7 @@ newtype Another_typedef_enum_e __exported by:__ @edge-cases\/distilled_lib_1.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Another_typedef_enum_e where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -214,6 +215,7 @@ newtype A_type_t -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -244,6 +246,7 @@ newtype Var_t -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -550,6 +553,7 @@ newtype A_typedef_enum_e __exported by:__ @edge-cases\/distilled_lib_1.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable A_typedef_enum_e where sizeOf = \_ -> 1 :: Int alignment = \_ -> 1 :: Int @@ -650,6 +654,7 @@ newtype Callback_t_Deref __exported by:__ @edge-cases\/distilled_lib_1.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toCallback_t_Deref :: Callback_t_Deref -> IO (FunPtr Callback_t_Deref) foreign import ccall safe "dynamic" fromCallback_t_Deref :: FunPtr Callback_t_Deref -> @@ -683,7 +688,7 @@ newtype Callback_t __exported by:__ @edge-cases\/distilled_lib_1.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Callback_t "un_Callback_t") => HasField "un_Callback_t" (Ptr Callback_t) (Ptr ty) where getField = ptrToCField (Proxy @"un_Callback_t") diff --git a/hs-bindgen/fixtures/edge-cases/iterator/Example.hs b/hs-bindgen/fixtures/edge-cases/iterator/Example.hs index 3a187af70..1c86ff93d 100644 --- a/hs-bindgen/fixtures/edge-cases/iterator/Example.hs +++ b/hs-bindgen/fixtures/edge-cases/iterator/Example.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -16,6 +17,7 @@ import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.Block +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import HsBindgen.Runtime.TypeEquality (TyEq) import Prelude (IO) @@ -29,6 +31,7 @@ import Prelude (IO) newtype Toggle = Toggle { un_Toggle :: HsBindgen.Runtime.Block.Block (IO FC.CBool) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Toggle) "un_Toggle") ) => GHC.Records.HasField "un_Toggle" (Ptr.Ptr Toggle) (Ptr.Ptr ty) where @@ -52,6 +55,7 @@ instance HsBindgen.Runtime.HasCField.HasCField Toggle "un_Toggle" where newtype Counter = Counter { un_Counter :: HsBindgen.Runtime.Block.Block (IO FC.CInt) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Counter) "un_Counter") ) => GHC.Records.HasField "un_Counter" (Ptr.Ptr Counter) (Ptr.Ptr ty) where @@ -75,6 +79,7 @@ instance HsBindgen.Runtime.HasCField.HasCField Counter "un_Counter" where newtype VarCounter = VarCounter { un_VarCounter :: HsBindgen.Runtime.Block.Block (FC.CInt -> IO FC.CInt) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType VarCounter) "un_VarCounter") ) => GHC.Records.HasField "un_VarCounter" (Ptr.Ptr VarCounter) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/edge-cases/iterator/bindingspec.yaml b/hs-bindgen/fixtures/edge-cases/iterator/bindingspec.yaml index 8a6609a9a..b4b4649a5 100644 --- a/hs-bindgen/fixtures/edge-cases/iterator/bindingspec.yaml +++ b/hs-bindgen/fixtures/edge-cases/iterator/bindingspec.yaml @@ -15,5 +15,11 @@ ctypes: hsname: VarCounter hstypes: - hsname: Counter + instances: + - HasBaseForeignType - hsname: Toggle + instances: + - HasBaseForeignType - hsname: VarCounter + instances: + - HasBaseForeignType diff --git a/hs-bindgen/fixtures/edge-cases/iterator/th.txt b/hs-bindgen/fixtures/edge-cases/iterator/th.txt index f5e2da7c7..48f0b5989 100644 --- a/hs-bindgen/fixtures/edge-cases/iterator/th.txt +++ b/hs-bindgen/fixtures/edge-cases/iterator/th.txt @@ -200,6 +200,7 @@ newtype Toggle __exported by:__ @edge-cases\/iterator.h@ -} + deriving newtype HasBaseForeignType instance TyEq ty (CFieldType Toggle "un_Toggle") => HasField "un_Toggle" (Ptr Toggle) (Ptr ty) where getField = ptrToCField (Proxy @"un_Toggle") @@ -220,6 +221,7 @@ newtype Counter __exported by:__ @edge-cases\/iterator.h@ -} + deriving newtype HasBaseForeignType instance TyEq ty (CFieldType Counter "un_Counter") => HasField "un_Counter" (Ptr Counter) (Ptr ty) where getField = ptrToCField (Proxy @"un_Counter") @@ -240,6 +242,7 @@ newtype VarCounter __exported by:__ @edge-cases\/iterator.h@ -} + deriving newtype HasBaseForeignType instance TyEq ty (CFieldType VarCounter "un_VarCounter") => HasField "un_VarCounter" (Ptr VarCounter) (Ptr ty) where getField = ptrToCField (Proxy @"un_VarCounter") diff --git a/hs-bindgen/fixtures/edge-cases/spec_examples/Example.hs b/hs-bindgen/fixtures/edge-cases/spec_examples/Example.hs index 96da8f82d..cd14f4b68 100644 --- a/hs-bindgen/fixtures/edge-cases/spec_examples/Example.hs +++ b/hs-bindgen/fixtures/edge-cases/spec_examples/Example.hs @@ -21,6 +21,7 @@ import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -38,7 +39,7 @@ newtype Int16_T = Int16_T { un_Int16_T :: FC.CShort } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Int16_T) "un_Int16_T") ) => GHC.Records.HasField "un_Int16_T" (Ptr.Ptr Int16_T) (Ptr.Ptr ty) where @@ -62,7 +63,7 @@ newtype Int32_T = Int32_T { un_Int32_T :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Int32_T) "un_Int32_T") ) => GHC.Records.HasField "un_Int32_T" (Ptr.Ptr Int32_T) (Ptr.Ptr ty) where @@ -86,7 +87,7 @@ newtype Int64_T = Int64_T { un_Int64_T :: FC.CLLong } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Int64_T) "un_Int64_T") ) => GHC.Records.HasField "un_Int64_T" (Ptr.Ptr Int64_T) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/edge-cases/spec_examples/bindingspec.yaml b/hs-bindgen/fixtures/edge-cases/spec_examples/bindingspec.yaml index a97a9a62d..bb862060a 100644 --- a/hs-bindgen/fixtures/edge-cases/spec_examples/bindingspec.yaml +++ b/hs-bindgen/fixtures/edge-cases/spec_examples/bindingspec.yaml @@ -49,6 +49,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -64,6 +65,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -79,6 +81,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/edge-cases/spec_examples/th.txt b/hs-bindgen/fixtures/edge-cases/spec_examples/th.txt index 615d76768..526d09519 100644 --- a/hs-bindgen/fixtures/edge-cases/spec_examples/th.txt +++ b/hs-bindgen/fixtures/edge-cases/spec_examples/th.txt @@ -52,6 +52,7 @@ newtype Int16_T -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -82,6 +83,7 @@ newtype Int32_T -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -112,6 +114,7 @@ newtype Int64_T -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/edge-cases/uses_utf8/Example.hs b/hs-bindgen/fixtures/edge-cases/uses_utf8/Example.hs index 9da032dff..e7b1d62cd 100644 --- a/hs-bindgen/fixtures/edge-cases/uses_utf8/Example.hs +++ b/hs-bindgen/fixtures/edge-cases/uses_utf8/Example.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Example where @@ -9,6 +11,7 @@ import qualified Data.List.NonEmpty import qualified Foreign as F import qualified Foreign.C as FC import qualified HsBindgen.Runtime.CEnum +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified Text.Read import Prelude ((<*>), Eq, Int, Ord, Read, Show, pure, showsPrec) @@ -22,6 +25,7 @@ newtype MyEnum = MyEnum { un_MyEnum :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable MyEnum where diff --git a/hs-bindgen/fixtures/edge-cases/uses_utf8/bindingspec.yaml b/hs-bindgen/fixtures/edge-cases/uses_utf8/bindingspec.yaml index a41256117..94435efba 100644 --- a/hs-bindgen/fixtures/edge-cases/uses_utf8/bindingspec.yaml +++ b/hs-bindgen/fixtures/edge-cases/uses_utf8/bindingspec.yaml @@ -11,6 +11,7 @@ hstypes: - hsname: MyEnum instances: - Eq + - HasBaseForeignType - Ord - Read - Show diff --git a/hs-bindgen/fixtures/edge-cases/uses_utf8/th.txt b/hs-bindgen/fixtures/edge-cases/uses_utf8/th.txt index c81e1d51f..a27021ffd 100644 --- a/hs-bindgen/fixtures/edge-cases/uses_utf8/th.txt +++ b/hs-bindgen/fixtures/edge-cases/uses_utf8/th.txt @@ -14,6 +14,7 @@ newtype MyEnum __exported by:__ @edge-cases\/uses_utf8.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable MyEnum where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int diff --git a/hs-bindgen/fixtures/functions/callbacks/Example.hs b/hs-bindgen/fixtures/functions/callbacks/Example.hs index c9f3eaac5..e490f908d 100644 --- a/hs-bindgen/fixtures/functions/callbacks/Example.hs +++ b/hs-bindgen/fixtures/functions/callbacks/Example.hs @@ -29,6 +29,7 @@ import qualified HsBindgen.Runtime.ByteArray import qualified HsBindgen.Runtime.CEnum import qualified HsBindgen.Runtime.ConstantArray import qualified HsBindgen.Runtime.FunPtr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.SizedByteArray import qualified Text.Read @@ -45,6 +46,7 @@ __exported by:__ @functions\/callbacks.h@ newtype FileOpenedNotification_Deref = FileOpenedNotification_Deref { un_FileOpenedNotification_Deref :: IO () } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toFileOpenedNotification_Deref :: FileOpenedNotification_Deref @@ -85,7 +87,7 @@ newtype FileOpenedNotification = FileOpenedNotification { un_FileOpenedNotification :: Ptr.FunPtr FileOpenedNotification_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType FileOpenedNotification) "un_FileOpenedNotification") ) => GHC.Records.HasField "un_FileOpenedNotification" (Ptr.Ptr FileOpenedNotification) (Ptr.Ptr ty) where @@ -109,6 +111,7 @@ __exported by:__ @functions\/callbacks.h@ newtype ProgressUpdate_Deref = ProgressUpdate_Deref { un_ProgressUpdate_Deref :: FC.CInt -> IO () } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toProgressUpdate_Deref :: ProgressUpdate_Deref @@ -149,7 +152,7 @@ newtype ProgressUpdate = ProgressUpdate { un_ProgressUpdate :: Ptr.FunPtr ProgressUpdate_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType ProgressUpdate) "un_ProgressUpdate") ) => GHC.Records.HasField "un_ProgressUpdate" (Ptr.Ptr ProgressUpdate) (Ptr.Ptr ty) where @@ -173,6 +176,7 @@ __exported by:__ @functions\/callbacks.h@ newtype DataValidator_Deref = DataValidator_Deref { un_DataValidator_Deref :: FC.CInt -> IO FC.CInt } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toDataValidator_Deref :: DataValidator_Deref @@ -213,7 +217,7 @@ newtype DataValidator = DataValidator { un_DataValidator :: Ptr.FunPtr DataValidator_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType DataValidator) "un_DataValidator") ) => GHC.Records.HasField "un_DataValidator" (Ptr.Ptr DataValidator) (Ptr.Ptr ty) where @@ -307,6 +311,7 @@ __exported by:__ @functions\/callbacks.h@ newtype MeasurementReceived_Deref = MeasurementReceived_Deref { un_MeasurementReceived_Deref :: (Ptr.Ptr Measurement) -> IO () } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toMeasurementReceived_Deref :: MeasurementReceived_Deref @@ -347,7 +352,7 @@ newtype MeasurementReceived = MeasurementReceived { un_MeasurementReceived :: Ptr.FunPtr MeasurementReceived_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType MeasurementReceived) "un_MeasurementReceived") ) => GHC.Records.HasField "un_MeasurementReceived" (Ptr.Ptr MeasurementReceived) (Ptr.Ptr ty) where @@ -395,7 +400,7 @@ newtype MeasurementReceived2 = MeasurementReceived2 { un_MeasurementReceived2 :: Ptr.FunPtr MeasurementReceived2_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType MeasurementReceived2) "un_MeasurementReceived2") ) => GHC.Records.HasField "un_MeasurementReceived2" (Ptr.Ptr MeasurementReceived2) (Ptr.Ptr ty) where @@ -443,7 +448,7 @@ newtype SampleBufferFull = SampleBufferFull { un_SampleBufferFull :: Ptr.FunPtr SampleBufferFull_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType SampleBufferFull) "un_SampleBufferFull") ) => GHC.Records.HasField "un_SampleBufferFull" (Ptr.Ptr SampleBufferFull) (Ptr.Ptr ty) where @@ -788,6 +793,7 @@ newtype Processor_mode = Processor_mode { un_Processor_mode :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Processor_mode where @@ -956,7 +962,7 @@ newtype Foo = Foo { un_Foo :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Foo) "un_Foo") ) => GHC.Records.HasField "un_Foo" (Ptr.Ptr Foo) (Ptr.Ptr ty) where @@ -980,7 +986,7 @@ newtype Foo2 = Foo2 { un_Foo2 :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Foo2) "un_Foo2") ) => GHC.Records.HasField "un_Foo2" (Ptr.Ptr Foo2) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/functions/callbacks/bindingspec.yaml b/hs-bindgen/fixtures/functions/callbacks/bindingspec.yaml index 07492781d..4cdbe5625 100644 --- a/hs-bindgen/fixtures/functions/callbacks/bindingspec.yaml +++ b/hs-bindgen/fixtures/functions/callbacks/bindingspec.yaml @@ -73,17 +73,23 @@ hstypes: - hsname: DataValidator instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: DataValidator_Deref + instances: + - HasBaseForeignType - hsname: FileOpenedNotification instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: FileOpenedNotification_Deref + instances: + - HasBaseForeignType - hsname: Foo instances: - Bits @@ -91,6 +97,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -106,6 +113,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -127,17 +135,21 @@ hstypes: - hsname: MeasurementReceived instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: MeasurementReceived2 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: MeasurementReceived2_Deref - hsname: MeasurementReceived_Deref + instances: + - HasBaseForeignType - hsname: Processor instances: - Storable @@ -147,6 +159,7 @@ hstypes: - hsname: Processor_mode instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -154,13 +167,17 @@ hstypes: - hsname: ProgressUpdate instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: ProgressUpdate_Deref + instances: + - HasBaseForeignType - hsname: SampleBufferFull instances: - Eq + - HasBaseForeignType - Ord - Show - Storable diff --git a/hs-bindgen/fixtures/functions/callbacks/th.txt b/hs-bindgen/fixtures/functions/callbacks/th.txt index cbfcde0af..3b72075cc 100644 --- a/hs-bindgen/fixtures/functions/callbacks/th.txt +++ b/hs-bindgen/fixtures/functions/callbacks/th.txt @@ -436,6 +436,7 @@ newtype FileOpenedNotification_Deref __exported by:__ @functions\/callbacks.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toFileOpenedNotification_Deref :: FileOpenedNotification_Deref -> IO (FunPtr FileOpenedNotification_Deref) foreign import ccall safe "dynamic" fromFileOpenedNotification_Deref :: FunPtr FileOpenedNotification_Deref -> @@ -471,7 +472,7 @@ newtype FileOpenedNotification __exported by:__ @functions\/callbacks.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType FileOpenedNotification "un_FileOpenedNotification") => HasField "un_FileOpenedNotification" @@ -498,6 +499,7 @@ newtype ProgressUpdate_Deref __exported by:__ @functions\/callbacks.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toProgressUpdate_Deref :: ProgressUpdate_Deref -> IO (FunPtr ProgressUpdate_Deref) foreign import ccall safe "dynamic" fromProgressUpdate_Deref :: FunPtr ProgressUpdate_Deref -> @@ -531,7 +533,7 @@ newtype ProgressUpdate __exported by:__ @functions\/callbacks.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType ProgressUpdate "un_ProgressUpdate") => HasField "un_ProgressUpdate" (Ptr ProgressUpdate) (Ptr ty) where getField = ptrToCField (Proxy @"un_ProgressUpdate") @@ -553,6 +555,7 @@ newtype DataValidator_Deref __exported by:__ @functions\/callbacks.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toDataValidator_Deref :: DataValidator_Deref -> IO (FunPtr DataValidator_Deref) foreign import ccall safe "dynamic" fromDataValidator_Deref :: FunPtr DataValidator_Deref -> @@ -586,7 +589,7 @@ newtype DataValidator __exported by:__ @functions\/callbacks.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType DataValidator "un_DataValidator") => HasField "un_DataValidator" (Ptr DataValidator) (Ptr ty) where getField = ptrToCField (Proxy @"un_DataValidator") @@ -657,6 +660,7 @@ newtype MeasurementReceived_Deref __exported by:__ @functions\/callbacks.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toMeasurementReceived_Deref :: MeasurementReceived_Deref -> IO (FunPtr MeasurementReceived_Deref) foreign import ccall safe "dynamic" fromMeasurementReceived_Deref :: FunPtr MeasurementReceived_Deref -> @@ -692,7 +696,7 @@ newtype MeasurementReceived __exported by:__ @functions\/callbacks.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType MeasurementReceived "un_MeasurementReceived") => HasField "un_MeasurementReceived" @@ -745,7 +749,7 @@ newtype MeasurementReceived2 __exported by:__ @functions\/callbacks.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType MeasurementReceived2 "un_MeasurementReceived2") => HasField "un_MeasurementReceived2" @@ -798,7 +802,7 @@ newtype SampleBufferFull __exported by:__ @functions\/callbacks.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType SampleBufferFull "un_SampleBufferFull") => HasField "un_SampleBufferFull" (Ptr SampleBufferFull) (Ptr ty) @@ -1127,6 +1131,7 @@ newtype Processor_mode __exported by:__ @functions\/callbacks.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Processor_mode where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -1259,6 +1264,7 @@ newtype Foo -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -1289,6 +1295,7 @@ newtype Foo2 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/functions/circular_dependency_fun/Example.hs b/hs-bindgen/fixtures/functions/circular_dependency_fun/Example.hs index 1ac991164..43bcc680d 100644 --- a/hs-bindgen/fixtures/functions/circular_dependency_fun/Example.hs +++ b/hs-bindgen/fixtures/functions/circular_dependency_fun/Example.hs @@ -18,6 +18,7 @@ import qualified Foreign as F import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.FunPtr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import HsBindgen.Runtime.TypeEquality (TyEq) import Prelude ((<*>), Eq, IO, Int, Ord, Show, pure) @@ -31,6 +32,7 @@ __exported by:__ @functions\/circular_dependency_fun.h@ newtype Fun_ptr_Deref = Fun_ptr_Deref { un_Fun_ptr_Deref :: (Ptr.Ptr Forward_declaration) -> IO () } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toFun_ptr_Deref :: Fun_ptr_Deref @@ -71,7 +73,7 @@ newtype Fun_ptr = Fun_ptr { un_Fun_ptr :: Ptr.FunPtr Fun_ptr_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Fun_ptr) "un_Fun_ptr") ) => GHC.Records.HasField "un_Fun_ptr" (Ptr.Ptr Fun_ptr) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/functions/circular_dependency_fun/bindingspec.yaml b/hs-bindgen/fixtures/functions/circular_dependency_fun/bindingspec.yaml index 68da7dff2..b0480d82f 100644 --- a/hs-bindgen/fixtures/functions/circular_dependency_fun/bindingspec.yaml +++ b/hs-bindgen/fixtures/functions/circular_dependency_fun/bindingspec.yaml @@ -22,7 +22,10 @@ hstypes: - hsname: Fun_ptr instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Fun_ptr_Deref + instances: + - HasBaseForeignType diff --git a/hs-bindgen/fixtures/functions/circular_dependency_fun/th.txt b/hs-bindgen/fixtures/functions/circular_dependency_fun/th.txt index 8df72b694..962d44134 100644 --- a/hs-bindgen/fixtures/functions/circular_dependency_fun/th.txt +++ b/hs-bindgen/fixtures/functions/circular_dependency_fun/th.txt @@ -14,6 +14,7 @@ newtype Fun_ptr_Deref __exported by:__ @functions\/circular_dependency_fun.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toFun_ptr_Deref :: Fun_ptr_Deref -> IO (FunPtr Fun_ptr_Deref) foreign import ccall safe "dynamic" fromFun_ptr_Deref :: FunPtr Fun_ptr_Deref -> @@ -44,7 +45,7 @@ newtype Fun_ptr __exported by:__ @functions\/circular_dependency_fun.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Fun_ptr "un_Fun_ptr") => HasField "un_Fun_ptr" (Ptr Fun_ptr) (Ptr ty) where getField = ptrToCField (Proxy @"un_Fun_ptr") diff --git a/hs-bindgen/fixtures/functions/fun_attributes/Example.hs b/hs-bindgen/fixtures/functions/fun_attributes/Example.hs index 7a95d8305..5cfb34900 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes/Example.hs +++ b/hs-bindgen/fixtures/functions/fun_attributes/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -60,7 +61,7 @@ newtype Size_t = Size_t { un_Size_t :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Size_t) "un_Size_t") ) => GHC.Records.HasField "un_Size_t" (Ptr.Ptr Size_t) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/functions/fun_attributes/bindingspec.yaml b/hs-bindgen/fixtures/functions/fun_attributes/bindingspec.yaml index 1ab6d4877..c03afeeb6 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes/bindingspec.yaml +++ b/hs-bindgen/fixtures/functions/fun_attributes/bindingspec.yaml @@ -23,6 +23,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/functions/fun_attributes/th.txt b/hs-bindgen/fixtures/functions/fun_attributes/th.txt index cd58ea6e2..890412bec 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes/th.txt +++ b/hs-bindgen/fixtures/functions/fun_attributes/th.txt @@ -470,6 +470,7 @@ newtype Size_t -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/globals/globals/Example.hs b/hs-bindgen/fixtures/globals/globals/Example.hs index a28cea376..00710413e 100644 --- a/hs-bindgen/fixtures/globals/globals/Example.hs +++ b/hs-bindgen/fixtures/globals/globals/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude @@ -401,7 +402,7 @@ newtype ConstInt = ConstInt { un_ConstInt :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType ConstInt) "un_ConstInt") ) => GHC.Records.HasField "un_ConstInt" (Ptr.Ptr ConstInt) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/globals/globals/bindingspec.yaml b/hs-bindgen/fixtures/globals/globals/bindingspec.yaml index e34ae40de..666b48946 100644 --- a/hs-bindgen/fixtures/globals/globals/bindingspec.yaml +++ b/hs-bindgen/fixtures/globals/globals/bindingspec.yaml @@ -41,6 +41,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/globals/globals/th.txt b/hs-bindgen/fixtures/globals/globals/th.txt index d381b4a57..8ee85fd1d 100644 --- a/hs-bindgen/fixtures/globals/globals/th.txt +++ b/hs-bindgen/fixtures/globals/globals/th.txt @@ -445,6 +445,7 @@ newtype ConstInt -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl/Example.hs b/hs-bindgen/fixtures/macros/macro_in_fundecl/Example.hs index 84457de3e..acb76799e 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl/Example.hs +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl/Example.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UndecidableInstances #-} module Example where @@ -11,6 +12,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.FunPtr +import qualified HsBindgen.Runtime.HasBaseForeignType import Data.Bits (FiniteBits) import Prelude (Bounded, Enum, Eq, Floating, Fractional, IO, Integral, Num, Ord, Read, Real, RealFloat, RealFrac, Show) @@ -24,7 +26,7 @@ newtype I = I { un_I :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @C@ @@ -36,7 +38,7 @@ newtype C = C { un_C :: FC.CChar } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @F@ @@ -48,7 +50,7 @@ newtype F = F { un_F :: FC.CFloat } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) {-| __C declaration:__ @L@ @@ -60,7 +62,7 @@ newtype L = L { un_L :: FC.CLong } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @S@ @@ -72,7 +74,7 @@ newtype S = S { un_S :: FC.CShort } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __unique:__ @instance ToFunPtr (FC.CShort -> IO I)@ -} diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl/bindingspec.yaml b/hs-bindgen/fixtures/macros/macro_in_fundecl/bindingspec.yaml index cd5fa371f..7dbee7d03 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl/bindingspec.yaml +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl/bindingspec.yaml @@ -27,6 +27,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -41,6 +42,7 @@ hstypes: - Eq - Floating - Fractional + - HasBaseForeignType - Num - Ord - Read @@ -56,6 +58,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -71,6 +74,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -86,6 +90,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl/th.txt b/hs-bindgen/fixtures/macros/macro_in_fundecl/th.txt index 66c155b95..25b1f40c0 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl/th.txt +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl/th.txt @@ -327,6 +327,7 @@ newtype I -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -351,6 +352,7 @@ newtype C -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -375,6 +377,7 @@ newtype F -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Enum, Floating, Fractional, @@ -398,6 +401,7 @@ newtype L -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -422,6 +426,7 @@ newtype S -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example.hs b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example.hs index 8d1f13438..6156dd8b0 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example.hs +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype MC = MC { un_MC :: FC.CChar } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @TC@ @@ -46,7 +47,7 @@ newtype TC = TC { un_TC :: FC.CChar } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType TC) "un_TC") ) => GHC.Records.HasField "un_TC" (Ptr.Ptr TC) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/bindingspec.yaml b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/bindingspec.yaml index d569c1a2d..89ce111fb 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/bindingspec.yaml +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/bindingspec.yaml @@ -33,6 +33,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -73,6 +74,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/th.txt b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/th.txt index 536cff27e..8357a06cd 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/th.txt +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/th.txt @@ -246,6 +246,7 @@ newtype MC -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -270,6 +271,7 @@ newtype TC -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/macros/macro_redefines_global/Example.hs b/hs-bindgen/fixtures/macros/macro_redefines_global/Example.hs index 82f5343ad..68a0af51e 100644 --- a/hs-bindgen/fixtures/macros/macro_redefines_global/Example.hs +++ b/hs-bindgen/fixtures/macros/macro_redefines_global/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype FILE = FILE { un_FILE :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType FILE) "un_FILE") ) => GHC.Records.HasField "un_FILE" (Ptr.Ptr FILE) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/macros/macro_redefines_global/bindingspec.yaml b/hs-bindgen/fixtures/macros/macro_redefines_global/bindingspec.yaml index 04a06e51d..2063e0b31 100644 --- a/hs-bindgen/fixtures/macros/macro_redefines_global/bindingspec.yaml +++ b/hs-bindgen/fixtures/macros/macro_redefines_global/bindingspec.yaml @@ -15,6 +15,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/macros/macro_redefines_global/th.txt b/hs-bindgen/fixtures/macros/macro_redefines_global/th.txt index ad7175f66..55db77d50 100644 --- a/hs-bindgen/fixtures/macros/macro_redefines_global/th.txt +++ b/hs-bindgen/fixtures/macros/macro_redefines_global/th.txt @@ -15,6 +15,7 @@ newtype FILE -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/macros/macro_typedef_scope/Example.hs b/hs-bindgen/fixtures/macros/macro_typedef_scope/Example.hs index 22b431fb9..5404c5c03 100644 --- a/hs-bindgen/fixtures/macros/macro_typedef_scope/Example.hs +++ b/hs-bindgen/fixtures/macros/macro_typedef_scope/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype T1 = T1 { un_T1 :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @T2@ @@ -46,7 +47,7 @@ newtype T2 = T2 { un_T2 :: T1 } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType T2) "un_T2") ) => GHC.Records.HasField "un_T2" (Ptr.Ptr T2) (Ptr.Ptr ty) where @@ -70,7 +71,7 @@ newtype T3 = T3 { un_T3 :: T2 } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @T4@ @@ -82,7 +83,7 @@ newtype T4 = T4 { un_T4 :: T3 } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType T4) "un_T4") ) => GHC.Records.HasField "un_T4" (Ptr.Ptr T4) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/macros/macro_typedef_scope/bindingspec.yaml b/hs-bindgen/fixtures/macros/macro_typedef_scope/bindingspec.yaml index eb0439ecc..61d3a2553 100644 --- a/hs-bindgen/fixtures/macros/macro_typedef_scope/bindingspec.yaml +++ b/hs-bindgen/fixtures/macros/macro_typedef_scope/bindingspec.yaml @@ -24,6 +24,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -39,6 +40,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -54,6 +56,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -69,6 +72,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/macros/macro_typedef_scope/th.txt b/hs-bindgen/fixtures/macros/macro_typedef_scope/th.txt index bff5190f8..107602be3 100644 --- a/hs-bindgen/fixtures/macros/macro_typedef_scope/th.txt +++ b/hs-bindgen/fixtures/macros/macro_typedef_scope/th.txt @@ -15,6 +15,7 @@ newtype T1 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -39,6 +40,7 @@ newtype T2 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -69,6 +71,7 @@ newtype T3 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -93,6 +96,7 @@ newtype T4 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/macros/macro_typedef_struct/Example.hs b/hs-bindgen/fixtures/macros/macro_typedef_struct/Example.hs index befd3266f..13c90ed52 100644 --- a/hs-bindgen/fixtures/macros/macro_typedef_struct/Example.hs +++ b/hs-bindgen/fixtures/macros/macro_typedef_struct/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype MY_TYPE = MY_TYPE { un_MY_TYPE :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __defined at:__ @macros\/macro_typedef_struct.h:3:9@ diff --git a/hs-bindgen/fixtures/macros/macro_typedef_struct/bindingspec.yaml b/hs-bindgen/fixtures/macros/macro_typedef_struct/bindingspec.yaml index 9653b36b4..ec73524bc 100644 --- a/hs-bindgen/fixtures/macros/macro_typedef_struct/bindingspec.yaml +++ b/hs-bindgen/fixtures/macros/macro_typedef_struct/bindingspec.yaml @@ -23,6 +23,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/macros/macro_typedef_struct/th.txt b/hs-bindgen/fixtures/macros/macro_typedef_struct/th.txt index 045de5f9e..8c90516cc 100644 --- a/hs-bindgen/fixtures/macros/macro_typedef_struct/th.txt +++ b/hs-bindgen/fixtures/macros/macro_typedef_struct/th.txt @@ -15,6 +15,7 @@ newtype MY_TYPE -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/macros/macro_types/Example.hs b/hs-bindgen/fixtures/macros/macro_types/Example.hs index c9979bd08..34b23e800 100644 --- a/hs-bindgen/fixtures/macros/macro_types/Example.hs +++ b/hs-bindgen/fixtures/macros/macro_types/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype PtrInt = PtrInt { un_PtrInt :: Ptr.Ptr FC.CInt } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) {-| __C declaration:__ @PtrPtrChar@ @@ -46,7 +47,7 @@ newtype PtrPtrChar = PtrPtrChar { un_PtrPtrChar :: Ptr.Ptr (Ptr.Ptr FC.CChar) } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) {-| __C declaration:__ @MTy@ @@ -58,7 +59,7 @@ newtype MTy = MTy { un_MTy :: FC.CFloat } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) {-| __C declaration:__ @tty@ @@ -70,7 +71,7 @@ newtype Tty = Tty { un_Tty :: MTy } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Tty) "un_Tty") ) => GHC.Records.HasField "un_Tty" (Ptr.Ptr Tty) (Ptr.Ptr ty) where @@ -94,7 +95,7 @@ newtype UINT8_T = UINT8_T { un_UINT8_T :: FC.CUChar } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @BOOLEAN_T@ @@ -106,7 +107,7 @@ newtype BOOLEAN_T = BOOLEAN_T { un_BOOLEAN_T :: UINT8_T } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @boolean_T@ @@ -118,7 +119,7 @@ newtype Boolean_T = Boolean_T { un_Boolean_T :: BOOLEAN_T } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Boolean_T) "un_Boolean_T") ) => GHC.Records.HasField "un_Boolean_T" (Ptr.Ptr Boolean_T) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/macros/macro_types/bindingspec.yaml b/hs-bindgen/fixtures/macros/macro_types/bindingspec.yaml index 1cf1f0798..0eb80a54f 100644 --- a/hs-bindgen/fixtures/macros/macro_types/bindingspec.yaml +++ b/hs-bindgen/fixtures/macros/macro_types/bindingspec.yaml @@ -33,6 +33,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -48,6 +49,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -62,6 +64,7 @@ hstypes: - Eq - Floating - Fractional + - HasBaseForeignType - Num - Ord - Read @@ -73,12 +76,14 @@ hstypes: - hsname: PtrInt instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: PtrPtrChar instances: - Eq + - HasBaseForeignType - Ord - Show - Storable @@ -88,6 +93,7 @@ hstypes: - Eq - Floating - Fractional + - HasBaseForeignType - Num - Ord - Read @@ -103,6 +109,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/macros/macro_types/th.txt b/hs-bindgen/fixtures/macros/macro_types/th.txt index 39b572dc0..47cfbb7ea 100644 --- a/hs-bindgen/fixtures/macros/macro_types/th.txt +++ b/hs-bindgen/fixtures/macros/macro_types/th.txt @@ -14,7 +14,7 @@ newtype PtrInt __exported by:__ @macros\/macro_types.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) {-| __C declaration:__ @PtrPtrChar@ __defined at:__ @macros\/macro_types.h:5:9@ @@ -30,7 +30,7 @@ newtype PtrPtrChar __exported by:__ @macros\/macro_types.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) {-| __C declaration:__ @MTy@ __defined at:__ @macros\/macro_types.h:8:9@ @@ -47,6 +47,7 @@ newtype MTy -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Enum, Floating, Fractional, @@ -70,6 +71,7 @@ newtype Tty -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Enum, Floating, Fractional, @@ -99,6 +101,7 @@ newtype UINT8_T -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -123,6 +126,7 @@ newtype BOOLEAN_T -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -147,6 +151,7 @@ newtype Boolean_T -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/macros/reparse/Example.hs b/hs-bindgen/fixtures/macros/reparse/Example.hs index dbbd861d3..38c8158ee 100644 --- a/hs-bindgen/fixtures/macros/reparse/Example.hs +++ b/hs-bindgen/fixtures/macros/reparse/Example.hs @@ -28,6 +28,7 @@ import qualified GHC.Records import qualified HsBindgen.Runtime.CEnum import qualified HsBindgen.Runtime.ConstantArray import qualified HsBindgen.Runtime.FunPtr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.SizedByteArray @@ -46,7 +47,7 @@ newtype A = A { un_A :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @some_struct@ @@ -94,6 +95,7 @@ newtype Some_enum = Some_enum { un_Some_enum :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Some_enum where @@ -272,7 +274,7 @@ newtype Typedef1 = Typedef1 { un_Typedef1 :: A } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Typedef1) "un_Typedef1") ) => GHC.Records.HasField "un_Typedef1" (Ptr.Ptr Typedef1) (Ptr.Ptr ty) where @@ -296,7 +298,7 @@ newtype Typedef2 = Typedef2 { un_Typedef2 :: Ptr.Ptr A } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Typedef2) "un_Typedef2") ) => GHC.Records.HasField "un_Typedef2" (Ptr.Ptr Typedef2) (Ptr.Ptr ty) where @@ -320,7 +322,7 @@ newtype Typedef3 = Typedef3 { un_Typedef3 :: Ptr.Ptr (Ptr.Ptr A) } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Typedef3) "un_Typedef3") ) => GHC.Records.HasField "un_Typedef3" (Ptr.Ptr Typedef3) (Ptr.Ptr ty) where @@ -344,6 +346,7 @@ __exported by:__ @macros\/reparse.h@ newtype Funptr_typedef1_Deref = Funptr_typedef1_Deref { un_Funptr_typedef1_Deref :: IO A } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toFunptr_typedef1_Deref :: Funptr_typedef1_Deref @@ -384,7 +387,7 @@ newtype Funptr_typedef1 = Funptr_typedef1 { un_Funptr_typedef1 :: Ptr.FunPtr Funptr_typedef1_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Funptr_typedef1) "un_Funptr_typedef1") ) => GHC.Records.HasField "un_Funptr_typedef1" (Ptr.Ptr Funptr_typedef1) (Ptr.Ptr ty) where @@ -408,6 +411,7 @@ __exported by:__ @macros\/reparse.h@ newtype Funptr_typedef2_Deref = Funptr_typedef2_Deref { un_Funptr_typedef2_Deref :: IO (Ptr.Ptr A) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toFunptr_typedef2_Deref :: Funptr_typedef2_Deref @@ -448,7 +452,7 @@ newtype Funptr_typedef2 = Funptr_typedef2 { un_Funptr_typedef2 :: Ptr.FunPtr Funptr_typedef2_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Funptr_typedef2) "un_Funptr_typedef2") ) => GHC.Records.HasField "un_Funptr_typedef2" (Ptr.Ptr Funptr_typedef2) (Ptr.Ptr ty) where @@ -472,6 +476,7 @@ __exported by:__ @macros\/reparse.h@ newtype Funptr_typedef3_Deref = Funptr_typedef3_Deref { un_Funptr_typedef3_Deref :: IO (Ptr.Ptr (Ptr.Ptr A)) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toFunptr_typedef3_Deref :: Funptr_typedef3_Deref @@ -512,7 +517,7 @@ newtype Funptr_typedef3 = Funptr_typedef3 { un_Funptr_typedef3 :: Ptr.FunPtr Funptr_typedef3_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Funptr_typedef3) "un_Funptr_typedef3") ) => GHC.Records.HasField "un_Funptr_typedef3" (Ptr.Ptr Funptr_typedef3) (Ptr.Ptr ty) where @@ -536,6 +541,7 @@ __exported by:__ @macros\/reparse.h@ newtype Funptr_typedef4_Deref = Funptr_typedef4_Deref { un_Funptr_typedef4_Deref :: FC.CInt -> FC.CDouble -> IO A } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toFunptr_typedef4_Deref :: Funptr_typedef4_Deref @@ -576,7 +582,7 @@ newtype Funptr_typedef4 = Funptr_typedef4 { un_Funptr_typedef4 :: Ptr.FunPtr Funptr_typedef4_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Funptr_typedef4) "un_Funptr_typedef4") ) => GHC.Records.HasField "un_Funptr_typedef4" (Ptr.Ptr Funptr_typedef4) (Ptr.Ptr ty) where @@ -600,6 +606,7 @@ __exported by:__ @macros\/reparse.h@ newtype Funptr_typedef5_Deref = Funptr_typedef5_Deref { un_Funptr_typedef5_Deref :: FC.CInt -> FC.CDouble -> IO (Ptr.Ptr A) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toFunptr_typedef5_Deref :: Funptr_typedef5_Deref @@ -640,7 +647,7 @@ newtype Funptr_typedef5 = Funptr_typedef5 { un_Funptr_typedef5 :: Ptr.FunPtr Funptr_typedef5_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Funptr_typedef5) "un_Funptr_typedef5") ) => GHC.Records.HasField "un_Funptr_typedef5" (Ptr.Ptr Funptr_typedef5) (Ptr.Ptr ty) where @@ -665,7 +672,7 @@ newtype Comments2 = Comments2 { un_Comments2 :: A } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Comments2) "un_Comments2") ) => GHC.Records.HasField "un_Comments2" (Ptr.Ptr Comments2) (Ptr.Ptr ty) where @@ -786,7 +793,7 @@ newtype Const_typedef1 = Const_typedef1 { un_Const_typedef1 :: A } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_typedef1) "un_Const_typedef1") ) => GHC.Records.HasField "un_Const_typedef1" (Ptr.Ptr Const_typedef1) (Ptr.Ptr ty) where @@ -811,7 +818,7 @@ newtype Const_typedef2 = Const_typedef2 { un_Const_typedef2 :: A } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_typedef2) "un_Const_typedef2") ) => GHC.Records.HasField "un_Const_typedef2" (Ptr.Ptr Const_typedef2) (Ptr.Ptr ty) where @@ -836,7 +843,7 @@ newtype Const_typedef3 = Const_typedef3 { un_Const_typedef3 :: Ptr.Ptr A } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_typedef3) "un_Const_typedef3") ) => GHC.Records.HasField "un_Const_typedef3" (Ptr.Ptr Const_typedef3) (Ptr.Ptr ty) where @@ -861,7 +868,7 @@ newtype Const_typedef4 = Const_typedef4 { un_Const_typedef4 :: Ptr.Ptr A } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_typedef4) "un_Const_typedef4") ) => GHC.Records.HasField "un_Const_typedef4" (Ptr.Ptr Const_typedef4) (Ptr.Ptr ty) where @@ -886,7 +893,7 @@ newtype Const_typedef5 = Const_typedef5 { un_Const_typedef5 :: Ptr.Ptr A } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_typedef5) "un_Const_typedef5") ) => GHC.Records.HasField "un_Const_typedef5" (Ptr.Ptr Const_typedef5) (Ptr.Ptr ty) where @@ -911,7 +918,7 @@ newtype Const_typedef6 = Const_typedef6 { un_Const_typedef6 :: Ptr.Ptr A } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_typedef6) "un_Const_typedef6") ) => GHC.Records.HasField "un_Const_typedef6" (Ptr.Ptr Const_typedef6) (Ptr.Ptr ty) where @@ -936,7 +943,7 @@ newtype Const_typedef7 = Const_typedef7 { un_Const_typedef7 :: Ptr.Ptr A } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_typedef7) "un_Const_typedef7") ) => GHC.Records.HasField "un_Const_typedef7" (Ptr.Ptr Const_typedef7) (Ptr.Ptr ty) where @@ -1147,6 +1154,7 @@ __exported by:__ @macros\/reparse.h@ newtype Const_funptr1_Deref = Const_funptr1_Deref { un_Const_funptr1_Deref :: FC.CInt -> FC.CDouble -> IO A } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toConst_funptr1_Deref :: Const_funptr1_Deref @@ -1187,7 +1195,7 @@ newtype Const_funptr1 = Const_funptr1 { un_Const_funptr1 :: Ptr.FunPtr Const_funptr1_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_funptr1) "un_Const_funptr1") ) => GHC.Records.HasField "un_Const_funptr1" (Ptr.Ptr Const_funptr1) (Ptr.Ptr ty) where @@ -1211,6 +1219,7 @@ __exported by:__ @macros\/reparse.h@ newtype Const_funptr2_Deref = Const_funptr2_Deref { un_Const_funptr2_Deref :: FC.CInt -> FC.CDouble -> IO A } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toConst_funptr2_Deref :: Const_funptr2_Deref @@ -1251,7 +1260,7 @@ newtype Const_funptr2 = Const_funptr2 { un_Const_funptr2 :: Ptr.FunPtr Const_funptr2_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_funptr2) "un_Const_funptr2") ) => GHC.Records.HasField "un_Const_funptr2" (Ptr.Ptr Const_funptr2) (Ptr.Ptr ty) where @@ -1275,6 +1284,7 @@ __exported by:__ @macros\/reparse.h@ newtype Const_funptr3_Deref = Const_funptr3_Deref { un_Const_funptr3_Deref :: FC.CInt -> FC.CDouble -> IO (Ptr.Ptr A) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toConst_funptr3_Deref :: Const_funptr3_Deref @@ -1315,7 +1325,7 @@ newtype Const_funptr3 = Const_funptr3 { un_Const_funptr3 :: Ptr.FunPtr Const_funptr3_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_funptr3) "un_Const_funptr3") ) => GHC.Records.HasField "un_Const_funptr3" (Ptr.Ptr Const_funptr3) (Ptr.Ptr ty) where @@ -1339,6 +1349,7 @@ __exported by:__ @macros\/reparse.h@ newtype Const_funptr4_Deref = Const_funptr4_Deref { un_Const_funptr4_Deref :: FC.CInt -> FC.CDouble -> IO (Ptr.Ptr A) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toConst_funptr4_Deref :: Const_funptr4_Deref @@ -1379,7 +1390,7 @@ newtype Const_funptr4 = Const_funptr4 { un_Const_funptr4 :: Ptr.FunPtr Const_funptr4_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_funptr4) "un_Const_funptr4") ) => GHC.Records.HasField "un_Const_funptr4" (Ptr.Ptr Const_funptr4) (Ptr.Ptr ty) where @@ -1403,6 +1414,7 @@ __exported by:__ @macros\/reparse.h@ newtype Const_funptr5_Deref = Const_funptr5_Deref { un_Const_funptr5_Deref :: FC.CInt -> FC.CDouble -> IO (Ptr.Ptr A) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toConst_funptr5_Deref :: Const_funptr5_Deref @@ -1443,7 +1455,7 @@ newtype Const_funptr5 = Const_funptr5 { un_Const_funptr5 :: Ptr.FunPtr Const_funptr5_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_funptr5) "un_Const_funptr5") ) => GHC.Records.HasField "un_Const_funptr5" (Ptr.Ptr Const_funptr5) (Ptr.Ptr ty) where @@ -1467,6 +1479,7 @@ __exported by:__ @macros\/reparse.h@ newtype Const_funptr6_Deref = Const_funptr6_Deref { un_Const_funptr6_Deref :: FC.CInt -> FC.CDouble -> IO (Ptr.Ptr A) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toConst_funptr6_Deref :: Const_funptr6_Deref @@ -1507,7 +1520,7 @@ newtype Const_funptr6 = Const_funptr6 { un_Const_funptr6 :: Ptr.FunPtr Const_funptr6_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_funptr6) "un_Const_funptr6") ) => GHC.Records.HasField "un_Const_funptr6" (Ptr.Ptr Const_funptr6) (Ptr.Ptr ty) where @@ -1531,6 +1544,7 @@ __exported by:__ @macros\/reparse.h@ newtype Const_funptr7_Deref = Const_funptr7_Deref { un_Const_funptr7_Deref :: FC.CInt -> FC.CDouble -> IO (Ptr.Ptr A) } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toConst_funptr7_Deref :: Const_funptr7_Deref @@ -1571,7 +1585,7 @@ newtype Const_funptr7 = Const_funptr7 { un_Const_funptr7 :: Ptr.FunPtr Const_funptr7_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Const_funptr7) "un_Const_funptr7") ) => GHC.Records.HasField "un_Const_funptr7" (Ptr.Ptr Const_funptr7) (Ptr.Ptr ty) where @@ -1596,7 +1610,7 @@ newtype BOOL = BOOL { un_BOOL :: FC.CBool } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @INT@ @@ -1608,7 +1622,7 @@ newtype INT = INT { un_INT :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @INTP@ @@ -1620,7 +1634,7 @@ newtype INTP = INTP { un_INTP :: Ptr.Ptr FC.CInt } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) {-| __C declaration:__ @INTCP@ @@ -1632,4 +1646,4 @@ newtype INTCP = INTCP { un_INTCP :: Ptr.Ptr FC.CInt } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) diff --git a/hs-bindgen/fixtures/macros/reparse/bindingspec.yaml b/hs-bindgen/fixtures/macros/reparse/bindingspec.yaml index 2bbb573bd..69c20ed7f 100644 --- a/hs-bindgen/fixtures/macros/reparse/bindingspec.yaml +++ b/hs-bindgen/fixtures/macros/reparse/bindingspec.yaml @@ -159,6 +159,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -192,6 +193,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -207,6 +209,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -218,52 +221,73 @@ hstypes: - hsname: Const_funptr1 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_funptr1_Deref + instances: + - HasBaseForeignType - hsname: Const_funptr2 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_funptr2_Deref + instances: + - HasBaseForeignType - hsname: Const_funptr3 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_funptr3_Deref + instances: + - HasBaseForeignType - hsname: Const_funptr4 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_funptr4_Deref + instances: + - HasBaseForeignType - hsname: Const_funptr5 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_funptr5_Deref + instances: + - HasBaseForeignType - hsname: Const_funptr6 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_funptr6_Deref + instances: + - HasBaseForeignType - hsname: Const_funptr7 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_funptr7_Deref + instances: + - HasBaseForeignType - hsname: Const_typedef1 instances: - Bits @@ -271,6 +295,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -286,6 +311,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -297,30 +323,35 @@ hstypes: - hsname: Const_typedef3 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_typedef4 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_typedef5 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_typedef6 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Const_typedef7 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable @@ -337,38 +368,53 @@ hstypes: - hsname: Funptr_typedef1 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Funptr_typedef1_Deref + instances: + - HasBaseForeignType - hsname: Funptr_typedef2 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Funptr_typedef2_Deref + instances: + - HasBaseForeignType - hsname: Funptr_typedef3 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Funptr_typedef3_Deref + instances: + - HasBaseForeignType - hsname: Funptr_typedef4 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Funptr_typedef4_Deref + instances: + - HasBaseForeignType - hsname: Funptr_typedef5 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Funptr_typedef5_Deref + instances: + - HasBaseForeignType - hsname: INT instances: - Bits @@ -376,6 +422,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -387,18 +434,21 @@ hstypes: - hsname: INTCP instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: INTP instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Some_enum instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -418,6 +468,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -429,12 +480,14 @@ hstypes: - hsname: Typedef2 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Typedef3 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable diff --git a/hs-bindgen/fixtures/macros/reparse/th.txt b/hs-bindgen/fixtures/macros/reparse/th.txt index ddb4a1221..4230da33f 100644 --- a/hs-bindgen/fixtures/macros/reparse/th.txt +++ b/hs-bindgen/fixtures/macros/reparse/th.txt @@ -2489,6 +2489,7 @@ newtype A -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -2548,6 +2549,7 @@ newtype Some_enum __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Some_enum where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -2697,6 +2699,7 @@ newtype Typedef1 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -2726,7 +2729,7 @@ newtype Typedef2 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Typedef2 "un_Typedef2") => HasField "un_Typedef2" (Ptr Typedef2) (Ptr ty) where getField = ptrToCField (Proxy @"un_Typedef2") @@ -2748,7 +2751,7 @@ newtype Typedef3 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Typedef3 "un_Typedef3") => HasField "un_Typedef3" (Ptr Typedef3) (Ptr ty) where getField = ptrToCField (Proxy @"un_Typedef3") @@ -2769,6 +2772,7 @@ newtype Funptr_typedef1_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toFunptr_typedef1_Deref :: Funptr_typedef1_Deref -> IO (FunPtr Funptr_typedef1_Deref) foreign import ccall safe "dynamic" fromFunptr_typedef1_Deref :: FunPtr Funptr_typedef1_Deref -> @@ -2802,7 +2806,7 @@ newtype Funptr_typedef1 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Funptr_typedef1 "un_Funptr_typedef1") => HasField "un_Funptr_typedef1" (Ptr Funptr_typedef1) (Ptr ty) @@ -2825,6 +2829,7 @@ newtype Funptr_typedef2_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toFunptr_typedef2_Deref :: Funptr_typedef2_Deref -> IO (FunPtr Funptr_typedef2_Deref) foreign import ccall safe "dynamic" fromFunptr_typedef2_Deref :: FunPtr Funptr_typedef2_Deref -> @@ -2858,7 +2863,7 @@ newtype Funptr_typedef2 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Funptr_typedef2 "un_Funptr_typedef2") => HasField "un_Funptr_typedef2" (Ptr Funptr_typedef2) (Ptr ty) @@ -2881,6 +2886,7 @@ newtype Funptr_typedef3_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toFunptr_typedef3_Deref :: Funptr_typedef3_Deref -> IO (FunPtr Funptr_typedef3_Deref) foreign import ccall safe "dynamic" fromFunptr_typedef3_Deref :: FunPtr Funptr_typedef3_Deref -> @@ -2914,7 +2920,7 @@ newtype Funptr_typedef3 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Funptr_typedef3 "un_Funptr_typedef3") => HasField "un_Funptr_typedef3" (Ptr Funptr_typedef3) (Ptr ty) @@ -2938,6 +2944,7 @@ newtype Funptr_typedef4_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toFunptr_typedef4_Deref :: Funptr_typedef4_Deref -> IO (FunPtr Funptr_typedef4_Deref) foreign import ccall safe "dynamic" fromFunptr_typedef4_Deref :: FunPtr Funptr_typedef4_Deref -> @@ -2971,7 +2978,7 @@ newtype Funptr_typedef4 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Funptr_typedef4 "un_Funptr_typedef4") => HasField "un_Funptr_typedef4" (Ptr Funptr_typedef4) (Ptr ty) @@ -2995,6 +3002,7 @@ newtype Funptr_typedef5_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toFunptr_typedef5_Deref :: Funptr_typedef5_Deref -> IO (FunPtr Funptr_typedef5_Deref) foreign import ccall safe "dynamic" fromFunptr_typedef5_Deref :: FunPtr Funptr_typedef5_Deref -> @@ -3028,7 +3036,7 @@ newtype Funptr_typedef5 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Funptr_typedef5 "un_Funptr_typedef5") => HasField "un_Funptr_typedef5" (Ptr Funptr_typedef5) (Ptr ty) @@ -3053,6 +3061,7 @@ newtype Comments2 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -3153,6 +3162,7 @@ newtype Const_typedef1 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -3183,6 +3193,7 @@ newtype Const_typedef2 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -3212,7 +3223,7 @@ newtype Const_typedef3 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_typedef3 "un_Const_typedef3") => HasField "un_Const_typedef3" (Ptr Const_typedef3) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_typedef3") @@ -3234,7 +3245,7 @@ newtype Const_typedef4 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_typedef4 "un_Const_typedef4") => HasField "un_Const_typedef4" (Ptr Const_typedef4) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_typedef4") @@ -3256,7 +3267,7 @@ newtype Const_typedef5 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_typedef5 "un_Const_typedef5") => HasField "un_Const_typedef5" (Ptr Const_typedef5) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_typedef5") @@ -3278,7 +3289,7 @@ newtype Const_typedef6 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_typedef6 "un_Const_typedef6") => HasField "un_Const_typedef6" (Ptr Const_typedef6) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_typedef6") @@ -3300,7 +3311,7 @@ newtype Const_typedef7 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_typedef7 "un_Const_typedef7") => HasField "un_Const_typedef7" (Ptr Const_typedef7) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_typedef7") @@ -3481,6 +3492,7 @@ newtype Const_funptr1_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toConst_funptr1_Deref :: Const_funptr1_Deref -> IO (FunPtr Const_funptr1_Deref) foreign import ccall safe "dynamic" fromConst_funptr1_Deref :: FunPtr Const_funptr1_Deref -> @@ -3514,7 +3526,7 @@ newtype Const_funptr1 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_funptr1 "un_Const_funptr1") => HasField "un_Const_funptr1" (Ptr Const_funptr1) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_funptr1") @@ -3537,6 +3549,7 @@ newtype Const_funptr2_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toConst_funptr2_Deref :: Const_funptr2_Deref -> IO (FunPtr Const_funptr2_Deref) foreign import ccall safe "dynamic" fromConst_funptr2_Deref :: FunPtr Const_funptr2_Deref -> @@ -3570,7 +3583,7 @@ newtype Const_funptr2 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_funptr2 "un_Const_funptr2") => HasField "un_Const_funptr2" (Ptr Const_funptr2) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_funptr2") @@ -3593,6 +3606,7 @@ newtype Const_funptr3_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toConst_funptr3_Deref :: Const_funptr3_Deref -> IO (FunPtr Const_funptr3_Deref) foreign import ccall safe "dynamic" fromConst_funptr3_Deref :: FunPtr Const_funptr3_Deref -> @@ -3626,7 +3640,7 @@ newtype Const_funptr3 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_funptr3 "un_Const_funptr3") => HasField "un_Const_funptr3" (Ptr Const_funptr3) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_funptr3") @@ -3649,6 +3663,7 @@ newtype Const_funptr4_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toConst_funptr4_Deref :: Const_funptr4_Deref -> IO (FunPtr Const_funptr4_Deref) foreign import ccall safe "dynamic" fromConst_funptr4_Deref :: FunPtr Const_funptr4_Deref -> @@ -3682,7 +3697,7 @@ newtype Const_funptr4 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_funptr4 "un_Const_funptr4") => HasField "un_Const_funptr4" (Ptr Const_funptr4) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_funptr4") @@ -3705,6 +3720,7 @@ newtype Const_funptr5_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toConst_funptr5_Deref :: Const_funptr5_Deref -> IO (FunPtr Const_funptr5_Deref) foreign import ccall safe "dynamic" fromConst_funptr5_Deref :: FunPtr Const_funptr5_Deref -> @@ -3738,7 +3754,7 @@ newtype Const_funptr5 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_funptr5 "un_Const_funptr5") => HasField "un_Const_funptr5" (Ptr Const_funptr5) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_funptr5") @@ -3761,6 +3777,7 @@ newtype Const_funptr6_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toConst_funptr6_Deref :: Const_funptr6_Deref -> IO (FunPtr Const_funptr6_Deref) foreign import ccall safe "dynamic" fromConst_funptr6_Deref :: FunPtr Const_funptr6_Deref -> @@ -3794,7 +3811,7 @@ newtype Const_funptr6 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_funptr6 "un_Const_funptr6") => HasField "un_Const_funptr6" (Ptr Const_funptr6) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_funptr6") @@ -3817,6 +3834,7 @@ newtype Const_funptr7_Deref __exported by:__ @macros\/reparse.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toConst_funptr7_Deref :: Const_funptr7_Deref -> IO (FunPtr Const_funptr7_Deref) foreign import ccall safe "dynamic" fromConst_funptr7_Deref :: FunPtr Const_funptr7_Deref -> @@ -3850,7 +3868,7 @@ newtype Const_funptr7 __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Const_funptr7 "un_Const_funptr7") => HasField "un_Const_funptr7" (Ptr Const_funptr7) (Ptr ty) where getField = ptrToCField (Proxy @"un_Const_funptr7") @@ -3874,6 +3892,7 @@ newtype BOOL -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -3898,6 +3917,7 @@ newtype INT -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -3921,7 +3941,7 @@ newtype INTP __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) {-| __C declaration:__ @INTCP@ __defined at:__ @macros\/reparse.h:283:9@ @@ -3937,7 +3957,7 @@ newtype INTCP __exported by:__ @macros\/reparse.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) {-| Function declarations __C declaration:__ @args_char1@ diff --git a/hs-bindgen/fixtures/manual/function_pointers/Example.hs b/hs-bindgen/fixtures/manual/function_pointers/Example.hs index 1d6515052..4c42026a0 100644 --- a/hs-bindgen/fixtures/manual/function_pointers/Example.hs +++ b/hs-bindgen/fixtures/manual/function_pointers/Example.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -22,6 +23,7 @@ import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.ByteArray import qualified HsBindgen.Runtime.FunPtr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.SizedByteArray import HsBindgen.Runtime.TypeEquality (TyEq) @@ -36,6 +38,7 @@ import Prelude ((<*>), Eq, IO, Int, Show, pure) newtype Int2int = Int2int { un_Int2int :: FC.CInt -> IO FC.CInt } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toInt2int :: Int2int diff --git a/hs-bindgen/fixtures/manual/function_pointers/bindingspec.yaml b/hs-bindgen/fixtures/manual/function_pointers/bindingspec.yaml index c53aaa99e..ab1d39a48 100644 --- a/hs-bindgen/fixtures/manual/function_pointers/bindingspec.yaml +++ b/hs-bindgen/fixtures/manual/function_pointers/bindingspec.yaml @@ -23,3 +23,5 @@ hstypes: instances: - Storable - hsname: Int2int + instances: + - HasBaseForeignType diff --git a/hs-bindgen/fixtures/manual/function_pointers/th.txt b/hs-bindgen/fixtures/manual/function_pointers/th.txt index 24bee26ea..d969f49e1 100644 --- a/hs-bindgen/fixtures/manual/function_pointers/th.txt +++ b/hs-bindgen/fixtures/manual/function_pointers/th.txt @@ -211,6 +211,7 @@ newtype Int2int __exported by:__ @manual\/function_pointers.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toInt2int :: Int2int -> IO (FunPtr Int2int) foreign import ccall safe "dynamic" fromInt2int :: FunPtr Int2int -> diff --git a/hs-bindgen/fixtures/manual/zero_copy/Example.hs b/hs-bindgen/fixtures/manual/zero_copy/Example.hs index 71b84cb50..e09e1dcf0 100644 --- a/hs-bindgen/fixtures/manual/zero_copy/Example.hs +++ b/hs-bindgen/fixtures/manual/zero_copy/Example.hs @@ -25,6 +25,7 @@ import qualified GHC.Records import qualified HsBindgen.Runtime.ByteArray import qualified HsBindgen.Runtime.ConstantArray import qualified HsBindgen.Runtime.FlexibleArrayMember +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.SizedByteArray import Data.Bits (FiniteBits) @@ -483,7 +484,7 @@ newtype MyInt = MyInt { un_MyInt :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType MyInt) "un_MyInt") ) => GHC.Records.HasField "un_MyInt" (Ptr.Ptr MyInt) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/manual/zero_copy/bindingspec.yaml b/hs-bindgen/fixtures/manual/zero_copy/bindingspec.yaml index b2bebb08e..f4d119fb6 100644 --- a/hs-bindgen/fixtures/manual/zero_copy/bindingspec.yaml +++ b/hs-bindgen/fixtures/manual/zero_copy/bindingspec.yaml @@ -65,6 +65,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/manual/zero_copy/th.txt b/hs-bindgen/fixtures/manual/zero_copy/th.txt index 24b36c4e9..b4be9925f 100644 --- a/hs-bindgen/fixtures/manual/zero_copy/th.txt +++ b/hs-bindgen/fixtures/manual/zero_copy/th.txt @@ -405,6 +405,7 @@ newtype MyInt -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example.hs b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example.hs index 1021e7671..a96328e5e 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example.hs +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -19,6 +20,7 @@ import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.CEnum +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified HsBindgen.Runtime.Prelude import qualified Text.Read @@ -35,6 +37,7 @@ newtype FileOperationStatus = FileOperationStatus { un_FileOperationStatus :: FC.CInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable FileOperationStatus where diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/bindingspec.yaml b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/bindingspec.yaml index 07d4a5766..245bfb25f 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/bindingspec.yaml +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/bindingspec.yaml @@ -19,6 +19,7 @@ hstypes: - hsname: FileOperationStatus instances: - Eq + - HasBaseForeignType - Ord - Read - Show diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/th.txt b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/th.txt index 63af8258a..6e94578f6 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/th.txt +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/th.txt @@ -50,6 +50,7 @@ newtype FileOperationStatus __exported by:__ @program-analysis\/program_slicing_selection.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable FileOperationStatus where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_simple/Example.hs b/hs-bindgen/fixtures/program-analysis/program_slicing_simple/Example.hs index c4f7815e4..c59b6ff9b 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_simple/Example.hs +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_simple/Example.hs @@ -20,6 +20,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -35,7 +36,7 @@ newtype Uint32_t = Uint32_t { un_Uint32_t :: FC.CUInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Uint32_t) "un_Uint32_t") ) => GHC.Records.HasField "un_Uint32_t" (Ptr.Ptr Uint32_t) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_simple/bindingspec.yaml b/hs-bindgen/fixtures/program-analysis/program_slicing_simple/bindingspec.yaml index aeec77edd..93dda0778 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_simple/bindingspec.yaml +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_simple/bindingspec.yaml @@ -23,6 +23,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_simple/th.txt b/hs-bindgen/fixtures/program-analysis/program_slicing_simple/th.txt index 573d8641e..00ba8130f 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_simple/th.txt +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_simple/th.txt @@ -18,6 +18,7 @@ newtype Uint32_t -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/Example.hs b/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/Example.hs index 8cce474ce..05dd0f97c 100644 --- a/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/Example.hs +++ b/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/Example.hs @@ -1,13 +1,16 @@ {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Example where import qualified Data.List.NonEmpty import qualified Foreign as F import qualified HsBindgen.Runtime.CEnum +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import qualified Text.Read import Prelude ((<*>), Eq, Int, Ord, Read, Show, pure, showsPrec) @@ -20,6 +23,7 @@ newtype Foo_enum = Foo_enum { un_Foo_enum :: HsBindgen.Runtime.Prelude.Word32 } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Foo_enum where diff --git a/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/bindingspec.yaml b/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/bindingspec.yaml index f21facded..4ea995911 100644 --- a/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/bindingspec.yaml +++ b/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/bindingspec.yaml @@ -11,6 +11,7 @@ hstypes: - hsname: Foo_enum instances: - Eq + - HasBaseForeignType - Ord - Read - Show diff --git a/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/th.txt b/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/th.txt index 98637fa59..ff1c8b5b6 100644 --- a/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/th.txt +++ b/hs-bindgen/fixtures/types/enums/enum_cpp_syntax/th.txt @@ -13,6 +13,7 @@ newtype Foo_enum __exported by:__ @types\/enums\/enum_cpp_syntax.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Foo_enum where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int diff --git a/hs-bindgen/fixtures/types/enums/enums/Example.hs b/hs-bindgen/fixtures/types/enums/enums/Example.hs index 2e07f92a1..b400c7200 100644 --- a/hs-bindgen/fixtures/types/enums/enums/Example.hs +++ b/hs-bindgen/fixtures/types/enums/enums/Example.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Example where @@ -9,6 +11,7 @@ import qualified Data.List.NonEmpty import qualified Foreign as F import qualified Foreign.C as FC import qualified HsBindgen.Runtime.CEnum +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified Text.Read import Prelude ((<*>), Eq, Int, Ord, Read, Show, pure, showsPrec) @@ -22,6 +25,7 @@ newtype First = First { un_First :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable First where @@ -111,6 +115,7 @@ newtype Second = Second { un_Second :: FC.CInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Second where @@ -210,6 +215,7 @@ newtype Same = Same { un_Same :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Same where @@ -297,6 +303,7 @@ newtype Nonseq = Nonseq { un_Nonseq :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Nonseq where @@ -386,6 +393,7 @@ newtype Packed = Packed { un_Packed :: FC.CUChar } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable Packed where @@ -483,6 +491,7 @@ newtype EnumA = EnumA { un_EnumA :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable EnumA where @@ -572,6 +581,7 @@ newtype EnumB = EnumB { un_EnumB :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable EnumB where @@ -661,6 +671,7 @@ newtype EnumC = EnumC { un_EnumC :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable EnumC where @@ -750,6 +761,7 @@ newtype EnumD_t = EnumD_t { un_EnumD_t :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable EnumD_t where diff --git a/hs-bindgen/fixtures/types/enums/enums/bindingspec.yaml b/hs-bindgen/fixtures/types/enums/enums/bindingspec.yaml index 3bc051496..7be09b146 100644 --- a/hs-bindgen/fixtures/types/enums/enums/bindingspec.yaml +++ b/hs-bindgen/fixtures/types/enums/enums/bindingspec.yaml @@ -35,6 +35,7 @@ hstypes: - hsname: EnumA instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -42,6 +43,7 @@ hstypes: - hsname: EnumB instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -49,6 +51,7 @@ hstypes: - hsname: EnumC instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -56,6 +59,7 @@ hstypes: - hsname: EnumD_t instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -63,6 +67,7 @@ hstypes: - hsname: First instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -70,6 +75,7 @@ hstypes: - hsname: Nonseq instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -77,6 +83,7 @@ hstypes: - hsname: Packed instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -84,6 +91,7 @@ hstypes: - hsname: Same instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -91,6 +99,7 @@ hstypes: - hsname: Second instances: - Eq + - HasBaseForeignType - Ord - Read - Show diff --git a/hs-bindgen/fixtures/types/enums/enums/th.txt b/hs-bindgen/fixtures/types/enums/enums/th.txt index ca1d852d9..966b9dedd 100644 --- a/hs-bindgen/fixtures/types/enums/enums/th.txt +++ b/hs-bindgen/fixtures/types/enums/enums/th.txt @@ -14,6 +14,7 @@ newtype First __exported by:__ @types\/enums\/enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable First where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -83,6 +84,7 @@ newtype Second __exported by:__ @types\/enums\/enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Second where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -167,6 +169,7 @@ newtype Same __exported by:__ @types\/enums\/enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Same where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -235,6 +238,7 @@ newtype Nonseq __exported by:__ @types\/enums\/enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Nonseq where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -314,6 +318,7 @@ newtype Packed __exported by:__ @types\/enums\/enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable Packed where sizeOf = \_ -> 1 :: Int alignment = \_ -> 1 :: Int @@ -394,6 +399,7 @@ newtype EnumA __exported by:__ @types\/enums\/enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable EnumA where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -463,6 +469,7 @@ newtype EnumB __exported by:__ @types\/enums\/enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable EnumB where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -532,6 +539,7 @@ newtype EnumC __exported by:__ @types\/enums\/enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable EnumC where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -601,6 +609,7 @@ newtype EnumD_t __exported by:__ @types\/enums\/enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable EnumD_t where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int diff --git a/hs-bindgen/fixtures/types/enums/nested_enums/Example.hs b/hs-bindgen/fixtures/types/enums/nested_enums/Example.hs index 09fedce51..326c70cd4 100644 --- a/hs-bindgen/fixtures/types/enums/nested_enums/Example.hs +++ b/hs-bindgen/fixtures/types/enums/nested_enums/Example.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -19,6 +20,7 @@ import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.CEnum +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified Text.Read import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,6 +36,7 @@ newtype EnumA = EnumA { un_EnumA :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable EnumA where @@ -168,6 +171,7 @@ newtype ExB_fieldB1 = ExB_fieldB1 { un_ExB_fieldB1 :: FC.CUInt } deriving stock (Eq, Ord) + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance F.Storable ExB_fieldB1 where diff --git a/hs-bindgen/fixtures/types/enums/nested_enums/bindingspec.yaml b/hs-bindgen/fixtures/types/enums/nested_enums/bindingspec.yaml index ef2592995..d31a0259d 100644 --- a/hs-bindgen/fixtures/types/enums/nested_enums/bindingspec.yaml +++ b/hs-bindgen/fixtures/types/enums/nested_enums/bindingspec.yaml @@ -20,6 +20,7 @@ hstypes: - hsname: EnumA instances: - Eq + - HasBaseForeignType - Ord - Read - Show @@ -37,6 +38,7 @@ hstypes: - hsname: ExB_fieldB1 instances: - Eq + - HasBaseForeignType - Ord - Read - Show diff --git a/hs-bindgen/fixtures/types/enums/nested_enums/th.txt b/hs-bindgen/fixtures/types/enums/nested_enums/th.txt index 7052bac9f..0cc142766 100644 --- a/hs-bindgen/fixtures/types/enums/nested_enums/th.txt +++ b/hs-bindgen/fixtures/types/enums/nested_enums/th.txt @@ -14,6 +14,7 @@ newtype EnumA __exported by:__ @types\/enums\/nested_enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable EnumA where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int @@ -112,6 +113,7 @@ newtype ExB_fieldB1 __exported by:__ @types\/enums\/nested_enums.h@ -} deriving stock (Eq, Ord) + deriving newtype HasBaseForeignType instance Storable ExB_fieldB1 where sizeOf = \_ -> 4 :: Int alignment = \_ -> 4 :: Int diff --git a/hs-bindgen/fixtures/types/primitives/bool/Example.hs b/hs-bindgen/fixtures/types/primitives/bool/Example.hs index e853b9159..5256c51da 100644 --- a/hs-bindgen/fixtures/types/primitives/bool/Example.hs +++ b/hs-bindgen/fixtures/types/primitives/bool/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -170,7 +171,7 @@ newtype BOOL = BOOL { un_BOOL :: FC.CBool } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @bools3@ diff --git a/hs-bindgen/fixtures/types/primitives/bool/bindingspec.yaml b/hs-bindgen/fixtures/types/primitives/bool/bindingspec.yaml index b454cba96..1edca55cc 100644 --- a/hs-bindgen/fixtures/types/primitives/bool/bindingspec.yaml +++ b/hs-bindgen/fixtures/types/primitives/bool/bindingspec.yaml @@ -24,6 +24,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/types/primitives/bool/th.txt b/hs-bindgen/fixtures/types/primitives/bool/th.txt index 6df997a3d..19dd06bf2 100644 --- a/hs-bindgen/fixtures/types/primitives/bool/th.txt +++ b/hs-bindgen/fixtures/types/primitives/bool/th.txt @@ -110,6 +110,7 @@ newtype BOOL -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/types/structs/simple_structs/Example.hs b/hs-bindgen/fixtures/types/structs/simple_structs/Example.hs index 48fbe774c..ec5b2f07d 100644 --- a/hs-bindgen/fixtures/types/structs/simple_structs/Example.hs +++ b/hs-bindgen/fixtures/types/structs/simple_structs/Example.hs @@ -17,6 +17,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import HsBindgen.Runtime.TypeEquality (TyEq) import Prelude ((<*>), (>>), Eq, Int, Ord, Show, pure) @@ -524,7 +525,7 @@ newtype S7a = S7a { un_S7a :: Ptr.Ptr S7a_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType S7a) "un_S7a") ) => GHC.Records.HasField "un_S7a" (Ptr.Ptr S7a) (Ptr.Ptr ty) where @@ -614,7 +615,7 @@ newtype S7b = S7b { un_S7b :: Ptr.Ptr (Ptr.Ptr (Ptr.Ptr S7b_Deref)) } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType S7b) "un_S7b") ) => GHC.Records.HasField "un_S7b" (Ptr.Ptr S7b) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/types/structs/simple_structs/bindingspec.yaml b/hs-bindgen/fixtures/types/structs/simple_structs/bindingspec.yaml index 13b062b3c..25dd24a0d 100644 --- a/hs-bindgen/fixtures/types/structs/simple_structs/bindingspec.yaml +++ b/hs-bindgen/fixtures/types/structs/simple_structs/bindingspec.yaml @@ -68,6 +68,7 @@ hstypes: - hsname: S7a instances: - Eq + - HasBaseForeignType - Ord - Show - Storable @@ -79,6 +80,7 @@ hstypes: - hsname: S7b instances: - Eq + - HasBaseForeignType - Ord - Show - Storable diff --git a/hs-bindgen/fixtures/types/structs/simple_structs/th.txt b/hs-bindgen/fixtures/types/structs/simple_structs/th.txt index 8a87cf133..4f7048e4f 100644 --- a/hs-bindgen/fixtures/types/structs/simple_structs/th.txt +++ b/hs-bindgen/fixtures/types/structs/simple_structs/th.txt @@ -349,7 +349,7 @@ newtype S7a __exported by:__ @types\/structs\/simple_structs.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType S7a "un_S7a") => HasField "un_S7a" (Ptr S7a) (Ptr ty) where getField = ptrToCField (Proxy @"un_S7a") @@ -414,7 +414,7 @@ newtype S7b __exported by:__ @types\/structs\/simple_structs.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType S7b "un_S7b") => HasField "un_S7b" (Ptr S7b) (Ptr ty) where getField = ptrToCField (Proxy @"un_S7b") diff --git a/hs-bindgen/fixtures/types/typedefs/typedef_analysis/Example.hs b/hs-bindgen/fixtures/types/typedefs/typedef_analysis/Example.hs index 307330d22..ab686e0b5 100644 --- a/hs-bindgen/fixtures/types/typedefs/typedef_analysis/Example.hs +++ b/hs-bindgen/fixtures/types/typedefs/typedef_analysis/Example.hs @@ -18,6 +18,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import HsBindgen.Runtime.TypeEquality (TyEq) import Prelude ((<*>), (>>), Eq, Int, Ord, Show, pure, return) @@ -122,7 +123,7 @@ newtype Struct5_t = Struct5_t { un_Struct5_t :: Ptr.Ptr Struct5 } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Struct5_t) "un_Struct5_t") ) => GHC.Records.HasField "un_Struct5_t" (Ptr.Ptr Struct5_t) (Ptr.Ptr ty) where @@ -171,7 +172,7 @@ newtype Struct6 = Struct6 { un_Struct6 :: Ptr.Ptr Struct6_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Struct6) "un_Struct6") ) => GHC.Records.HasField "un_Struct6" (Ptr.Ptr Struct6) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/types/typedefs/typedef_analysis/bindingspec.yaml b/hs-bindgen/fixtures/types/typedefs/typedef_analysis/bindingspec.yaml index 548fb9aea..d44fc0b5c 100644 --- a/hs-bindgen/fixtures/types/typedefs/typedef_analysis/bindingspec.yaml +++ b/hs-bindgen/fixtures/types/typedefs/typedef_analysis/bindingspec.yaml @@ -105,12 +105,14 @@ hstypes: - hsname: Struct5_t instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Struct6 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable diff --git a/hs-bindgen/fixtures/types/typedefs/typedef_analysis/th.txt b/hs-bindgen/fixtures/types/typedefs/typedef_analysis/th.txt index 379e69a86..48c2e368d 100644 --- a/hs-bindgen/fixtures/types/typedefs/typedef_analysis/th.txt +++ b/hs-bindgen/fixtures/types/typedefs/typedef_analysis/th.txt @@ -95,7 +95,7 @@ newtype Struct5_t __exported by:__ @types\/typedefs\/typedef_analysis.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Struct5_t "un_Struct5_t") => HasField "un_Struct5_t" (Ptr Struct5_t) (Ptr ty) where getField = ptrToCField (Proxy @"un_Struct5_t") @@ -138,7 +138,7 @@ newtype Struct6 __exported by:__ @types\/typedefs\/typedef_analysis.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Struct6 "un_Struct6") => HasField "un_Struct6" (Ptr Struct6) (Ptr ty) where getField = ptrToCField (Proxy @"un_Struct6") diff --git a/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/Example.hs b/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/Example.hs index 10f46716e..c1acb6f5b 100644 --- a/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/Example.hs +++ b/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/Example.hs @@ -19,6 +19,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -34,7 +35,7 @@ newtype T1 = T1 { un_T1 :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType T1) "un_T1") ) => GHC.Records.HasField "un_T1" (Ptr.Ptr T1) (Ptr.Ptr ty) where @@ -58,7 +59,7 @@ newtype T2 = T2 { un_T2 :: FC.CChar } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType T2) "un_T2") ) => GHC.Records.HasField "un_T2" (Ptr.Ptr T2) (Ptr.Ptr ty) where @@ -82,7 +83,7 @@ newtype M1 = M1 { un_M1 :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @M2@ @@ -94,7 +95,7 @@ newtype M2 = M2 { un_M2 :: FC.CChar } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @M3@ @@ -106,7 +107,7 @@ newtype M3 = M3 { un_M3 :: Ptr.Ptr FC.CInt } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) {-| __C declaration:__ @ExampleStruct@ @@ -232,7 +233,7 @@ newtype Uint64_t = Uint64_t { un_Uint64_t :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) {-| __C declaration:__ @foo@ diff --git a/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/bindingspec.yaml b/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/bindingspec.yaml index 63c388754..19792112a 100644 --- a/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/bindingspec.yaml +++ b/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/bindingspec.yaml @@ -46,6 +46,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -61,6 +62,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -72,6 +74,7 @@ hstypes: - hsname: M3 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable @@ -82,6 +85,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -97,6 +101,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -112,6 +117,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num diff --git a/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/th.txt b/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/th.txt index d28a52161..becd286df 100644 --- a/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/th.txt +++ b/hs-bindgen/fixtures/types/typedefs/typedef_vs_macro/th.txt @@ -15,6 +15,7 @@ newtype T1 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -45,6 +46,7 @@ newtype T2 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -75,6 +77,7 @@ newtype M1 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -99,6 +102,7 @@ newtype M2 -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -122,7 +126,7 @@ newtype M3 __exported by:__ @types\/typedefs\/typedef_vs_macro.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) {-| __C declaration:__ @ExampleStruct@ __defined at:__ @types\/typedefs\/typedef_vs_macro.h:8:8@ @@ -214,6 +218,7 @@ newtype Uint64_t -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, diff --git a/hs-bindgen/fixtures/types/typedefs/typedefs/Example.hs b/hs-bindgen/fixtures/types/typedefs/typedefs/Example.hs index 359c5ca7e..721986628 100644 --- a/hs-bindgen/fixtures/types/typedefs/typedefs/Example.hs +++ b/hs-bindgen/fixtures/types/typedefs/typedefs/Example.hs @@ -21,6 +21,7 @@ import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.FunPtr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import Data.Bits (FiniteBits) import HsBindgen.Runtime.TypeEquality (TyEq) @@ -36,7 +37,7 @@ newtype Myint = Myint { un_Myint :: FC.CInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Bits.Bits, Bounded, Enum, FiniteBits, Integral, Ix.Ix, Num, Real) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Myint) "un_Myint") ) => GHC.Records.HasField "un_Myint" (Ptr.Ptr Myint) (Ptr.Ptr ty) where @@ -60,7 +61,7 @@ newtype Intptr = Intptr { un_Intptr :: Ptr.Ptr FC.CInt } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Intptr) "un_Intptr") ) => GHC.Records.HasField "un_Intptr" (Ptr.Ptr Intptr) (Ptr.Ptr ty) where @@ -83,6 +84,7 @@ instance HsBindgen.Runtime.HasCField.HasCField Intptr "un_Intptr" where newtype Int2int = Int2int { un_Int2int :: FC.CInt -> IO FC.CInt } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toInt2int :: Int2int @@ -122,6 +124,7 @@ __exported by:__ @types\/typedefs\/typedefs.h@ newtype FunctionPointer_Function_Deref = FunctionPointer_Function_Deref { un_FunctionPointer_Function_Deref :: IO () } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toFunctionPointer_Function_Deref :: FunctionPointer_Function_Deref @@ -162,7 +165,7 @@ newtype FunctionPointer_Function = FunctionPointer_Function { un_FunctionPointer_Function :: Ptr.FunPtr FunctionPointer_Function_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType FunctionPointer_Function) "un_FunctionPointer_Function") ) => GHC.Records.HasField "un_FunctionPointer_Function" (Ptr.Ptr FunctionPointer_Function) (Ptr.Ptr ty) where @@ -186,6 +189,7 @@ instance HsBindgen.Runtime.HasCField.HasCField FunctionPointer_Function "un_Func newtype NonFunctionPointer_Function = NonFunctionPointer_Function { un_NonFunctionPointer_Function :: FC.CInt -> IO FC.CInt } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toNonFunctionPointer_Function :: NonFunctionPointer_Function @@ -225,6 +229,7 @@ __exported by:__ @types\/typedefs\/typedefs.h@ newtype F1_Deref = F1_Deref { un_F1_Deref :: IO () } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toF1_Deref :: F1_Deref @@ -264,7 +269,7 @@ newtype F1 = F1 { un_F1 :: Ptr.FunPtr F1_Deref } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType F1) "un_F1") ) => GHC.Records.HasField "un_F1" (Ptr.Ptr F1) (Ptr.Ptr ty) where @@ -287,6 +292,7 @@ instance HsBindgen.Runtime.HasCField.HasCField F1 "un_F1" where newtype G1 = G1 { un_G1 :: IO () } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toG1 :: G1 @@ -326,7 +332,7 @@ newtype G2 = G2 { un_G2 :: Ptr.FunPtr G1 } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType G2) "un_G2") ) => GHC.Records.HasField "un_G2" (Ptr.Ptr G2) (Ptr.Ptr ty) where @@ -349,6 +355,7 @@ instance HsBindgen.Runtime.HasCField.HasCField G2 "un_G2" where newtype H1 = H1 { un_H1 :: IO () } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) foreign import ccall safe "wrapper" toH1 :: H1 @@ -387,6 +394,7 @@ instance HsBindgen.Runtime.HasCField.HasCField H1 "un_H1" where newtype H2 = H2 { un_H2 :: H1 } + deriving newtype (HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType H2) "un_H2") ) => GHC.Records.HasField "un_H2" (Ptr.Ptr H2) (Ptr.Ptr ty) where @@ -410,7 +418,7 @@ newtype H3 = H3 { un_H3 :: Ptr.FunPtr H2 } deriving stock (Eq, Ord, Show) - deriving newtype (F.Storable) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType H3) "un_H3") ) => GHC.Records.HasField "un_H3" (Ptr.Ptr H3) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/types/typedefs/typedefs/bindingspec.yaml b/hs-bindgen/fixtures/types/typedefs/typedefs/bindingspec.yaml index c2685f547..6a3a740f3 100644 --- a/hs-bindgen/fixtures/types/typedefs/typedefs/bindingspec.yaml +++ b/hs-bindgen/fixtures/types/typedefs/typedefs/bindingspec.yaml @@ -47,36 +47,53 @@ hstypes: - hsname: F1 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: F1_Deref + instances: + - HasBaseForeignType - hsname: FunctionPointer_Function instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: FunctionPointer_Function_Deref + instances: + - HasBaseForeignType - hsname: G1 + instances: + - HasBaseForeignType - hsname: G2 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: H1 + instances: + - HasBaseForeignType - hsname: H2 + instances: + - HasBaseForeignType - hsname: H3 instances: - Eq + - HasBaseForeignType - Ord - Show - Storable - hsname: Int2int + instances: + - HasBaseForeignType - hsname: Intptr instances: - Eq + - HasBaseForeignType - Ord - Show - Storable @@ -87,6 +104,7 @@ hstypes: - Enum - Eq - FiniteBits + - HasBaseForeignType - Integral - Ix - Num @@ -96,3 +114,5 @@ hstypes: - Show - Storable - hsname: NonFunctionPointer_Function + instances: + - HasBaseForeignType diff --git a/hs-bindgen/fixtures/types/typedefs/typedefs/th.txt b/hs-bindgen/fixtures/types/typedefs/typedefs/th.txt index 55bb0da3d..b8513ae19 100644 --- a/hs-bindgen/fixtures/types/typedefs/typedefs/th.txt +++ b/hs-bindgen/fixtures/types/typedefs/typedefs/th.txt @@ -15,6 +15,7 @@ newtype Myint -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Bits, Bounded, Enum, @@ -44,7 +45,7 @@ newtype Intptr __exported by:__ @types\/typedefs\/typedefs.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType Intptr "un_Intptr") => HasField "un_Intptr" (Ptr Intptr) (Ptr ty) where getField = ptrToCField (Proxy @"un_Intptr") @@ -65,6 +66,7 @@ newtype Int2int __exported by:__ @types\/typedefs\/typedefs.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toInt2int :: Int2int -> IO (FunPtr Int2int) foreign import ccall safe "dynamic" fromInt2int :: FunPtr Int2int -> @@ -93,6 +95,7 @@ newtype FunctionPointer_Function_Deref __exported by:__ @types\/typedefs\/typedefs.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toFunctionPointer_Function_Deref :: FunctionPointer_Function_Deref -> IO (FunPtr FunctionPointer_Function_Deref) foreign import ccall safe "dynamic" fromFunctionPointer_Function_Deref :: FunPtr FunctionPointer_Function_Deref -> @@ -128,7 +131,7 @@ newtype FunctionPointer_Function __exported by:__ @types\/typedefs\/typedefs.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType FunctionPointer_Function "un_FunctionPointer_Function") => @@ -156,6 +159,7 @@ newtype NonFunctionPointer_Function __exported by:__ @types\/typedefs\/typedefs.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toNonFunctionPointer_Function :: NonFunctionPointer_Function -> IO (FunPtr NonFunctionPointer_Function) foreign import ccall safe "dynamic" fromNonFunctionPointer_Function :: FunPtr NonFunctionPointer_Function -> @@ -190,6 +194,7 @@ newtype F1_Deref __exported by:__ @types\/typedefs\/typedefs.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toF1_Deref :: F1_Deref -> IO (FunPtr F1_Deref) foreign import ccall safe "dynamic" fromF1_Deref :: FunPtr F1_Deref -> @@ -219,7 +224,7 @@ newtype F1 __exported by:__ @types\/typedefs\/typedefs.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType F1 "un_F1") => HasField "un_F1" (Ptr F1) (Ptr ty) where getField = ptrToCField (Proxy @"un_F1") @@ -240,6 +245,7 @@ newtype G1 __exported by:__ @types\/typedefs\/typedefs.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toG1 :: G1 -> IO (FunPtr G1) foreign import ccall safe "dynamic" fromG1 :: FunPtr G1 -> G1 instance ToFunPtr G1 @@ -267,7 +273,7 @@ newtype G2 __exported by:__ @types\/typedefs\/typedefs.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType G2 "un_G2") => HasField "un_G2" (Ptr G2) (Ptr ty) where getField = ptrToCField (Proxy @"un_G2") @@ -288,6 +294,7 @@ newtype H1 __exported by:__ @types\/typedefs\/typedefs.h@ -} + deriving newtype HasBaseForeignType foreign import ccall safe "wrapper" toH1 :: H1 -> IO (FunPtr H1) foreign import ccall safe "dynamic" fromH1 :: FunPtr H1 -> H1 instance ToFunPtr H1 @@ -314,6 +321,7 @@ newtype H2 __exported by:__ @types\/typedefs\/typedefs.h@ -} + deriving newtype HasBaseForeignType instance TyEq ty (CFieldType H2 "un_H2") => HasField "un_H2" (Ptr H2) (Ptr ty) where getField = ptrToCField (Proxy @"un_H2") @@ -335,7 +343,7 @@ newtype H3 __exported by:__ @types\/typedefs\/typedefs.h@ -} deriving stock (Eq, Ord, Show) - deriving newtype Storable + deriving newtype (Storable, HasBaseForeignType) instance TyEq ty (CFieldType H3 "un_H3") => HasField "un_H3" (Ptr H3) (Ptr ty) where getField = ptrToCField (Proxy @"un_H3") diff --git a/hs-bindgen/fixtures/types/typedefs/typenames/Example.hs b/hs-bindgen/fixtures/types/typedefs/typenames/Example.hs index 38167afdf..8b196c653 100644 --- a/hs-bindgen/fixtures/types/typedefs/typenames/Example.hs +++ b/hs-bindgen/fixtures/types/typedefs/typenames/Example.hs @@ -20,6 +20,7 @@ import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified GHC.Records import qualified HsBindgen.Runtime.CEnum +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.HasCField import qualified Text.Read import HsBindgen.Runtime.TypeEquality (TyEq) @@ -35,7 +36,7 @@ newtype Foo = Foo { un_Foo :: FC.CUInt } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) instance F.Storable Foo where @@ -124,7 +125,7 @@ newtype Foo = Foo { un_Foo :: FC.CDouble } deriving stock (Eq, Ord, Read, Show) - deriving newtype (F.Storable, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) + deriving newtype (F.Storable, HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Foo) "un_Foo") ) => GHC.Records.HasField "un_Foo" (Ptr.Ptr Foo) (Ptr.Ptr ty) where diff --git a/hs-bindgen/fixtures/types/typedefs/typenames/bindingspec.yaml b/hs-bindgen/fixtures/types/typedefs/typenames/bindingspec.yaml index 3c4d47fc2..89c7c1ff9 100644 --- a/hs-bindgen/fixtures/types/typedefs/typenames/bindingspec.yaml +++ b/hs-bindgen/fixtures/types/typedefs/typenames/bindingspec.yaml @@ -14,6 +14,7 @@ hstypes: - hsname: Foo instances: - Eq + - HasBaseForeignType - Ord - Read - Show diff --git a/hs-bindgen/fixtures/types/typedefs/typenames/th.txt b/hs-bindgen/fixtures/types/typedefs/typenames/th.txt index 35c18d595..080bcc2f4 100644 --- a/hs-bindgen/fixtures/types/typedefs/typenames/th.txt +++ b/hs-bindgen/fixtures/types/typedefs/typenames/th.txt @@ -15,6 +15,7 @@ newtype Foo -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Enum, Floating, Fractional, @@ -92,6 +93,7 @@ newtype Foo -} deriving stock (Eq, Ord, Read, Show) deriving newtype (Storable, + HasBaseForeignType, Enum, Floating, Fractional, diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Extensions.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Extensions.hs index a129c1f34..f1fd90e24 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Extensions.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Extensions.hs @@ -94,6 +94,7 @@ globalExtensions = \case HasCBitfield_bitWidth# -> Set.singleton TH.MagicHash NomEq_class -> Set.singleton TH.TypeOperators HasField_class -> Set.singleton TH.UndecidableInstances + HasBaseForeignType_class -> Set.singleton TH.UndecidableInstances _ -> mempty exprExtensions :: SExpr ctx -> Set TH.Extension diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs index 87563eeb0..b1f4b3be4 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs @@ -627,7 +627,8 @@ enumDecs :: enumDecs opts haddockConfig info e spec = do State.modify' $ Map.insert newtypeName insts pure $ - newtypeDecl : storableDecl : optDecls ++ cEnumInstanceDecls ++ valueDecls + newtypeDecl : storableDecl : HsFI.hasBaseForeignTypeDecs insts hsNewtype ++ + optDecls ++ cEnumInstanceDecls ++ valueDecls where newtypeName :: Hs.Name Hs.NsTypeConstr newtypeName = C.unsafeDeclIdHaskellName info.declId @@ -644,7 +645,7 @@ enumDecs opts haddockConfig info e spec = do } insts :: Set Hs.TypeClass - insts = Set.union (Set.fromList [Hs.Show, Hs.Read, Hs.Storable]) $ + insts = Set.union (Set.fromList [Hs.Show, Hs.Read, Hs.Storable, Hs.HasBaseForeignType]) $ Set.fromList (snd <$> translationDeriveEnum opts) hsNewtype :: Hs.Newtype @@ -787,6 +788,7 @@ typedefDecs opts haddockConfig info typedef spec = do candidateInsts :: Set Hs.TypeClass candidateInsts = Set.unions [ Set.singleton Hs.Storable + , Set.singleton Hs.HasBaseForeignType , Set.fromList (snd <$> translationDeriveTypedef opts) ] @@ -815,8 +817,9 @@ typedefDecs opts haddockConfig info typedef spec = do -- everything in aux is state-dependent aux :: Hs.InstanceMap -> (Set Hs.TypeClass, [Hs.Decl]) aux instanceMap = (insts,) $ - (newtypeDecl : newtypeWrapper) ++ storableDecl ++ optDecls ++ - typedefFieldDecls hsNewtype + newtypeDecl : newtypeWrapper ++ storableDecl ++ optDecls ++ + typedefFieldDecls hsNewtype ++ + HsFI.hasBaseForeignTypeDecs insts hsNewtype where insts :: Set Hs.TypeClass insts = @@ -967,13 +970,16 @@ macroDecsTypedef opts haddockConfig info macroType spec = do newtypeName = C.unsafeDeclIdHaskellName info.declId candidateInsts :: Set Hs.TypeClass - candidateInsts = Set.union (Set.singleton Hs.Storable) $ - Set.fromList (snd <$> translationDeriveTypedef opts) + candidateInsts = Set.unions [ + Set.singleton Hs.Storable + , Set.singleton Hs.HasBaseForeignType + , Set.fromList (snd <$> translationDeriveTypedef opts) + ] -- everything in aux is state-dependent aux :: C.Type -> Hs.InstanceMap -> (Set Hs.TypeClass, [Hs.Decl]) aux ty instanceMap = (insts,) $ - newtypeDecl : storableDecl ++ optDecls + newtypeDecl : storableDecl ++ HsFI.hasBaseForeignTypeDecs insts hsNewtype ++ optDecls where fieldType :: HsType fieldType = Type.topLevel ty diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs index dbef42a4a..f73359835 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs @@ -1,6 +1,7 @@ --- | Generate Haskell foreign imports +-- | Generate Haskell foreign imports (using the 'HasBaseForeignType' class) module HsBindgen.Backend.Hs.Translation.ForeignImport ( foreignImportDecs + , hasBaseForeignTypeDecs ) where import HsBindgen.Backend.Hs.AST qualified as Hs @@ -10,6 +11,8 @@ import HsBindgen.Backend.Hs.Haddock.Documentation qualified as HsDoc import HsBindgen.Backend.Hs.Origin qualified as Origin import HsBindgen.Backend.SHs.AST import HsBindgen.Frontend.Naming qualified as C +import HsBindgen.Imports +import HsBindgen.Language.Haskell import HsBindgen.Language.Haskell qualified as Hs foreignImportDecs :: @@ -37,3 +40,19 @@ foreignImportDecs name resultType parameters origName callConv origin comment sa , foreignImportComment = comment , foreignImportSafety = safety } + +hasBaseForeignTypeDecs :: + Set TypeClass + -> Hs.Newtype + -> [Hs.Decl] +hasBaseForeignTypeDecs insts nt = + [mk | HasBaseForeignType `elem` insts] + where + mk :: Hs.Decl + mk = Hs.DeclDeriveInstance + Hs.DeriveInstance { + deriveInstanceStrategy = Hs.DeriveNewtype + , deriveInstanceClass = HasBaseForeignType + , deriveInstanceName = Hs.newtypeName nt + , deriveInstanceComment = Nothing + } diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs index 22c46601a..9ba91a1dc 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs @@ -44,8 +44,8 @@ getInstances instanceMap name = aux aux (acc /\ arrayInsts) $ hsType' : hsTypes HsPtr{} -> aux (acc /\ ptrInsts) hsTypes HsFunPtr{} -> aux (acc /\ ptrInsts) hsTypes - HsIO{} -> Set.empty - HsFun{} -> Set.empty + HsIO t -> aux (acc /\ ioInsts) (t : hsTypes) + HsFun arg res -> aux (acc /\ funInsts) (arg : res : hsTypes) HsExtBinding _ref _cTypeSpec mHsTypeSpec -> let acc' = case mHsTypeSpec of Just hsTypeSpec -> acc /\ hsTypeSpecInsts hsTypeSpec @@ -58,13 +58,22 @@ getInstances instanceMap name = aux let acc' = acc /\ Set.fromList [Eq, Show] in aux acc' hsTypes HsBlock t -> - aux acc (t:hsTypes) + aux (blockInsts /\ acc) (t:hsTypes) HsComplexType primType -> aux (acc /\ hsPrimTypeInsts primType) hsTypes HsStrLit{} -> Set.empty (/\) :: Ord a => Set a -> Set a -> Set a (/\) = Set.intersection + ioInsts :: Set TypeClass + ioInsts = Set.singleton HasBaseForeignType + + funInsts :: Set TypeClass + funInsts = Set.singleton HasBaseForeignType + + blockInsts :: Set TypeClass + blockInsts = Set.singleton HasBaseForeignType + hsPrimTypeInsts :: HsPrimType -> Set TypeClass hsPrimTypeInsts = \case HsPrimVoid -> Set.fromList [Eq, Ix, Ord, Read, Show] @@ -98,6 +107,7 @@ getInstances instanceMap name = aux , StaticSize , Storable , WriteRaw + , HasBaseForeignType ] integralInsts :: Set TypeClass @@ -118,6 +128,7 @@ getInstances instanceMap name = aux , StaticSize , Storable , WriteRaw + , HasBaseForeignType ] floatingInsts :: Set TypeClass @@ -137,6 +148,7 @@ getInstances instanceMap name = aux , StaticSize , Storable , WriteRaw + , HasBaseForeignType ] ptrInsts :: Set TypeClass @@ -148,6 +160,7 @@ getInstances instanceMap name = aux , StaticSize , Storable , WriteRaw + , HasBaseForeignType ] cArrayInsts :: Set TypeClass diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Names.hs b/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Names.hs index 6afab5753..3e2a9f517 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Names.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Names.hs @@ -43,6 +43,7 @@ import HsBindgen.Runtime.CAPI qualified import HsBindgen.Runtime.CEnum qualified import HsBindgen.Runtime.ConstantArray qualified import HsBindgen.Runtime.FlexibleArrayMember qualified +import HsBindgen.Runtime.HasBaseForeignType qualified import HsBindgen.Runtime.HasCField qualified import HsBindgen.Runtime.IncompleteArray qualified import HsBindgen.Runtime.Marshal qualified @@ -322,6 +323,9 @@ resolveGlobal = \case Proxy_type -> importQ ''Data.Proxy.Proxy Proxy_constructor -> importQ 'Data.Proxy.Proxy + -- HasBaseForeignType + HasBaseForeignType_class -> importQ ''HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType + -- Unsafe IO_unsafePerformIO -> importQ 'System.IO.Unsafe.unsafePerformIO diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs index 6448c049d..1cdc0f5c0 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs @@ -119,6 +119,9 @@ data Global = | Proxy_type | Proxy_constructor + -- HasBaseForeignType + | HasBaseForeignType_class + -- Unsafe | IO_unsafePerformIO diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs index 4b72b6c73..056de2835 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs @@ -159,26 +159,27 @@ translateDeriveInstance Hs.DeriveInstance{..} = DDerivingInstance } translateTypeClass :: Hs.TypeClass -> ClosedType -translateTypeClass Hs.Bits = TGlobal Bits_class -translateTypeClass Hs.Bounded = TGlobal Bounded_class -translateTypeClass Hs.Enum = TGlobal Enum_class -translateTypeClass Hs.Eq = TGlobal Eq_class -translateTypeClass Hs.FiniteBits = TGlobal FiniteBits_class -translateTypeClass Hs.Floating = TGlobal Floating_class -translateTypeClass Hs.Fractional = TGlobal Fractional_class -translateTypeClass Hs.Integral = TGlobal Integral_class -translateTypeClass Hs.Ix = TGlobal Ix_class -translateTypeClass Hs.Num = TGlobal Num_class -translateTypeClass Hs.Ord = TGlobal Ord_class -translateTypeClass Hs.Read = TGlobal Read_class -translateTypeClass Hs.ReadRaw = TGlobal ReadRaw_class -translateTypeClass Hs.Real = TGlobal Real_class -translateTypeClass Hs.RealFloat = TGlobal RealFloat_class -translateTypeClass Hs.RealFrac = TGlobal RealFrac_class -translateTypeClass Hs.Show = TGlobal Show_class -translateTypeClass Hs.StaticSize = TGlobal StaticSize_class -translateTypeClass Hs.Storable = TGlobal Storable_class -translateTypeClass Hs.WriteRaw = TGlobal WriteRaw_class +translateTypeClass Hs.Bits = TGlobal Bits_class +translateTypeClass Hs.Bounded = TGlobal Bounded_class +translateTypeClass Hs.Enum = TGlobal Enum_class +translateTypeClass Hs.Eq = TGlobal Eq_class +translateTypeClass Hs.FiniteBits = TGlobal FiniteBits_class +translateTypeClass Hs.Floating = TGlobal Floating_class +translateTypeClass Hs.Fractional = TGlobal Fractional_class +translateTypeClass Hs.Integral = TGlobal Integral_class +translateTypeClass Hs.Ix = TGlobal Ix_class +translateTypeClass Hs.Num = TGlobal Num_class +translateTypeClass Hs.Ord = TGlobal Ord_class +translateTypeClass Hs.Read = TGlobal Read_class +translateTypeClass Hs.ReadRaw = TGlobal ReadRaw_class +translateTypeClass Hs.Real = TGlobal Real_class +translateTypeClass Hs.RealFloat = TGlobal RealFloat_class +translateTypeClass Hs.RealFrac = TGlobal RealFrac_class +translateTypeClass Hs.Show = TGlobal Show_class +translateTypeClass Hs.StaticSize = TGlobal StaticSize_class +translateTypeClass Hs.Storable = TGlobal Storable_class +translateTypeClass Hs.WriteRaw = TGlobal WriteRaw_class +translateTypeClass Hs.HasBaseForeignType = TGlobal HasBaseForeignType_class translateForeignImportDecl :: Hs.ForeignImportDecl -> [SDecl] translateForeignImportDecl Hs.ForeignImportDecl { foreignImportParameters = args diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/TH/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/TH/Translation.hs index 681fc78af..372fbbefb 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/TH/Translation.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/TH/Translation.hs @@ -45,6 +45,7 @@ import HsBindgen.Runtime.CEnum qualified import HsBindgen.Runtime.ConstantArray qualified import HsBindgen.Runtime.FlexibleArrayMember qualified import HsBindgen.Runtime.FunPtr qualified +import HsBindgen.Runtime.HasBaseForeignType qualified import HsBindgen.Runtime.HasCField qualified import HsBindgen.Runtime.IncompleteArray qualified import HsBindgen.Runtime.Marshal qualified @@ -136,6 +137,9 @@ mkGlobal = \case Proxy_type -> ''Data.Proxy.Proxy Proxy_constructor -> 'Data.Proxy.Proxy + -- HasBaseForeignType + HasBaseForeignType_class -> ''HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType + -- Unsafe IO_unsafePerformIO -> 'System.IO.Unsafe.unsafePerformIO @@ -360,6 +364,9 @@ mkGlobalExpr n = case n of -- in definition order, no wildcards Proxy_type -> panicPure "type in expression" Proxy_constructor -> TH.conE name + -- HasBaseForeignType + HasBaseForeignType_class -> panicPure "class in expression" + -- Unsafe IO_unsafePerformIO -> TH.varE name diff --git a/hs-bindgen/src-internal/HsBindgen/BindingSpec/Private/Stdlib.hs b/hs-bindgen/src-internal/HsBindgen/BindingSpec/Private/Stdlib.hs index 22cfadb81..49828533c 100644 --- a/hs-bindgen/src-internal/HsBindgen/BindingSpec/Private/Stdlib.hs +++ b/hs-bindgen/src-internal/HsBindgen/BindingSpec/Private/Stdlib.hs @@ -149,6 +149,7 @@ bindingSpec = BindingSpec.BindingSpec{..} , Hs.StaticSize , Hs.Storable , Hs.WriteRaw + , Hs.HasBaseForeignType ] timeI :: [Hs.TypeClass] @@ -164,6 +165,7 @@ bindingSpec = BindingSpec.BindingSpec{..} , Hs.StaticSize , Hs.Storable , Hs.WriteRaw + , Hs.HasBaseForeignType ] aux :: diff --git a/hs-bindgen/src-internal/HsBindgen/Language/Haskell.hs b/hs-bindgen/src-internal/HsBindgen/Language/Haskell.hs index 9a28a8e9a..d4f3d5761 100644 --- a/hs-bindgen/src-internal/HsBindgen/Language/Haskell.hs +++ b/hs-bindgen/src-internal/HsBindgen/Language/Haskell.hs @@ -168,6 +168,7 @@ data TypeClass = | Real | RealFloat | RealFrac + | HasBaseForeignType -- Classes we can generate when all components have instances | StaticSize From c00f542455e43919b89ccc4558b36e599a75ab8d Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Mon, 1 Dec 2025 16:27:58 +0100 Subject: [PATCH 7/7] Use `HasBaseForeignType` in all foreign imports except for "dynamic"/"wrapper" --- .../fixtures/arrays/array/Example/FunPtr.hs | 244 +- .../fixtures/arrays/array/Example/Global.hs | 199 +- .../fixtures/arrays/array/Example/Safe.hs | 244 +- .../fixtures/arrays/array/Example/Unsafe.hs | 244 +- hs-bindgen/fixtures/arrays/array/th.txt | 1468 ++++- .../fixtures/attributes/asm/Example/FunPtr.hs | 10 +- .../fixtures/attributes/asm/Example/Global.hs | 10 +- .../fixtures/attributes/asm/Example/Safe.hs | 10 +- .../fixtures/attributes/asm/Example/Unsafe.hs | 10 +- hs-bindgen/fixtures/attributes/asm/th.txt | 55 +- .../visibility_attributes/Example/FunPtr.hs | 271 +- .../visibility_attributes/Example/Global.hs | 181 +- .../visibility_attributes/Example/Safe.hs | 271 +- .../visibility_attributes/Example/Unsafe.hs | 271 +- .../attributes/visibility_attributes/th.txt | 1246 +++- .../Example/FunPtr.hs | 10 +- .../Example/Safe.hs | 10 +- .../Example/Unsafe.hs | 10 +- .../declarations_required_for_scoping/th.txt | 42 +- .../definitions/Example/FunPtr.hs | 10 +- .../definitions/Example/Global.hs | 10 +- .../declarations/definitions/Example/Safe.hs | 10 +- .../definitions/Example/Unsafe.hs | 10 +- .../fixtures/declarations/definitions/th.txt | 50 +- .../redeclaration/Example/Global.hs | 10 +- .../declarations/redeclaration/th.txt | 8 +- .../tentative_definitions/Example/Global.hs | 28 +- .../declarations/tentative_definitions/th.txt | 24 +- .../doxygen_docs/Example/FunPtr.hs | 136 +- .../doxygen_docs/Example/Global.hs | 19 +- .../doxygen_docs/Example/Safe.hs | 136 +- .../doxygen_docs/Example/Unsafe.hs | 136 +- .../documentation/doxygen_docs/th.txt | 1229 +++- .../edge-cases/adios/Example/FunPtr.hs | 28 +- .../edge-cases/adios/Example/Global.hs | 19 +- .../fixtures/edge-cases/adios/Example/Safe.hs | 28 +- .../edge-cases/adios/Example/Unsafe.hs | 28 +- hs-bindgen/fixtures/edge-cases/adios/th.txt | 124 +- .../distilled_lib_1/Example/FunPtr.hs | 10 +- .../distilled_lib_1/Example/Global.hs | 10 +- .../distilled_lib_1/Example/Safe.hs | 10 +- .../distilled_lib_1/Example/Unsafe.hs | 10 +- .../edge-cases/distilled_lib_1/th.txt | 71 +- .../edge-cases/iterator/Example/FunPtr.hs | 82 +- .../edge-cases/iterator/Example/Safe.hs | 82 +- .../edge-cases/iterator/Example/Unsafe.hs | 82 +- .../fixtures/edge-cases/iterator/th.txt | 388 +- .../edge-cases/names/Example/FunPtr.hs | 226 +- .../fixtures/edge-cases/names/Example/Safe.hs | 226 +- .../edge-cases/names/Example/Unsafe.hs | 226 +- hs-bindgen/fixtures/edge-cases/names/th.txt | 900 ++- .../spec_examples/Example/FunPtr.hs | 10 +- .../edge-cases/spec_examples/Example/Safe.hs | 10 +- .../spec_examples/Example/Unsafe.hs | 10 +- .../fixtures/edge-cases/spec_examples/th.txt | 73 +- .../functions/callbacks/Example/FunPtr.hs | 145 +- .../functions/callbacks/Example/Safe.hs | 145 +- .../functions/callbacks/Example/Unsafe.hs | 145 +- .../fixtures/functions/callbacks/th.txt | 864 ++- .../decls_in_signature/Example/FunPtr.hs | 28 +- .../decls_in_signature/Example/Safe.hs | 28 +- .../decls_in_signature/Example/Unsafe.hs | 28 +- .../functions/decls_in_signature/th.txt | 116 +- .../fun_attributes/Example/FunPtr.hs | 217 +- .../fun_attributes/Example/Global.hs | 10 +- .../functions/fun_attributes/Example/Safe.hs | 217 +- .../fun_attributes/Example/Unsafe.hs | 217 +- .../fixtures/functions/fun_attributes/th.txt | 991 +++- .../fun_attributes_conflict/Example/FunPtr.hs | 37 +- .../fun_attributes_conflict/Example/Safe.hs | 37 +- .../fun_attributes_conflict/Example/Unsafe.hs | 37 +- .../functions/fun_attributes_conflict/th.txt | 184 +- .../functions/simple_func/Example/FunPtr.hs | 46 +- .../functions/simple_func/Example/Safe.hs | 46 +- .../functions/simple_func/Example/Unsafe.hs | 46 +- .../fixtures/functions/simple_func/th.txt | 212 +- .../functions/varargs/Example/FunPtr.hs | 10 +- .../functions/varargs/Example/Safe.hs | 10 +- .../functions/varargs/Example/Unsafe.hs | 10 +- hs-bindgen/fixtures/functions/varargs/th.txt | 36 +- .../globals/globals/Example/Global.hs | 271 +- hs-bindgen/fixtures/globals/globals/th.txt | 250 +- .../macros/macro_in_fundecl/Example/FunPtr.hs | 118 +- .../macros/macro_in_fundecl/Example/Safe.hs | 118 +- .../macros/macro_in_fundecl/Example/Unsafe.hs | 118 +- .../fixtures/macros/macro_in_fundecl/th.txt | 641 ++- .../Example/FunPtr.hs | 91 +- .../Example/Safe.hs | 91 +- .../Example/Unsafe.hs | 91 +- .../macros/macro_in_fundecl_vs_typedef/th.txt | 468 +- .../fixtures/macros/reparse/Example/FunPtr.hs | 1000 +++- .../fixtures/macros/reparse/Example/Safe.hs | 1000 +++- .../fixtures/macros/reparse/Example/Unsafe.hs | 1000 +++- hs-bindgen/fixtures/macros/reparse/th.txt | 5066 ++++++++++++++--- .../fixtures/manual/arrays/Example/FunPtr.hs | 19 +- .../fixtures/manual/arrays/Example/Global.hs | 55 +- .../fixtures/manual/arrays/Example/Safe.hs | 19 +- .../fixtures/manual/arrays/Example/Unsafe.hs | 19 +- hs-bindgen/fixtures/manual/arrays/th.txt | 152 +- .../function_pointers/Example/FunPtr.hs | 64 +- .../function_pointers/Example/Global.hs | 28 +- .../manual/function_pointers/Example/Safe.hs | 64 +- .../function_pointers/Example/Unsafe.hs | 64 +- .../fixtures/manual/function_pointers/th.txt | 393 +- .../manual/zero_copy/Example/FunPtr.hs | 19 +- .../fixtures/manual/zero_copy/Example/Safe.hs | 19 +- .../manual/zero_copy/Example/Unsafe.hs | 19 +- hs-bindgen/fixtures/manual/zero_copy/th.txt | 86 +- .../Example/FunPtr.hs | 10 +- .../program_slicing_selection/Example/Safe.hs | 10 +- .../Example/Unsafe.hs | 10 +- .../program_slicing_selection/th.txt | 61 +- .../complex_non_float_test/Example/Global.hs | 46 +- .../complex/complex_non_float_test/th.txt | 40 +- .../hsb_complex_test/Example/FunPtr.hs | 19 +- .../hsb_complex_test/Example/Global.hs | 127 +- .../complex/hsb_complex_test/Example/Safe.hs | 19 +- .../hsb_complex_test/Example/Unsafe.hs | 19 +- .../types/complex/hsb_complex_test/th.txt | 212 +- .../complex/vector_test/Example/FunPtr.hs | 10 +- .../types/complex/vector_test/Example/Safe.hs | 10 +- .../complex/vector_test/Example/Unsafe.hs | 10 +- .../fixtures/types/complex/vector_test/th.txt | 47 +- .../primitives/bool_c23/Example/Global.hs | 10 +- .../fixtures/types/primitives/bool_c23/th.txt | 8 +- .../type_qualifiers/Example/FunPtr.hs | 10 +- .../type_qualifiers/Example/Global.hs | 37 +- .../type_qualifiers/Example/Safe.hs | 10 +- .../type_qualifiers/Example/Unsafe.hs | 10 +- .../types/qualifiers/type_qualifiers/th.txt | 83 +- .../Example/FunPtr.hs | 10 +- .../parse_failure_long_double/Example/Safe.hs | 10 +- .../Example/Unsafe.hs | 10 +- .../special/parse_failure_long_double/th.txt | 42 +- .../structs/struct_arg/Example/FunPtr.hs | 37 +- .../types/structs/struct_arg/Example/Safe.hs | 37 +- .../structs/struct_arg/Example/Unsafe.hs | 37 +- .../fixtures/types/structs/struct_arg/th.txt | 166 +- .../HsBindgen/Backend/Hs/AST/Type.hs | 1 + .../HsBindgen/Backend/Hs/Translation.hs | 34 +- .../Backend/Hs/Translation/ForeignImport.hs | 79 +- .../Backend/Hs/Translation/Instances.hs | 1 + .../Backend/Hs/Translation/ToFromFunPtr.hs | 4 +- .../HsBindgen/Backend/HsModule/Names.hs | 2 + .../src-internal/HsBindgen/Backend/SHs/AST.hs | 2 + .../HsBindgen/Backend/SHs/Translation.hs | 1 + .../HsBindgen/Backend/TH/Translation.hs | 4 + 147 files changed, 22354 insertions(+), 3421 deletions(-) diff --git a/hs-bindgen/fixtures/arrays/array/Example/FunPtr.hs b/hs-bindgen/fixtures/arrays/array/Example/FunPtr.hs index de82c5150..e1a7010fe 100644 --- a/hs-bindgen/fixtures/arrays/array/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/arrays/array/Example/FunPtr.hs @@ -10,6 +10,7 @@ import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude import Example @@ -228,10 +229,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3da43df5677c71ad" hs_bindgen_3da43df5677c71ad_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3da43df5677c71ad" hs_bindgen_3da43df5677c71ad :: +hs_bindgen_3da43df5677c71ad :: IO (Ptr.FunPtr (FC.CInt -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt)) +hs_bindgen_3da43df5677c71ad = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3da43df5677c71ad_base {-# NOINLINE fun_1_ptr #-} @@ -247,10 +255,17 @@ fun_1_ptr :: Ptr.FunPtr (FC.CInt -> ((HsBindgen.Runtime.ConstantArray.ConstantAr fun_1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3da43df5677c71ad +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2170297251bf6d62" hs_bindgen_2170297251bf6d62_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Triplet -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2170297251bf6d62" hs_bindgen_2170297251bf6d62 :: +hs_bindgen_2170297251bf6d62 :: IO (Ptr.FunPtr (Triplet -> IO FC.CInt)) +hs_bindgen_2170297251bf6d62 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2170297251bf6d62_base {-# NOINLINE fun_2_ptr #-} @@ -266,10 +281,17 @@ fun_2_ptr :: Ptr.FunPtr (Triplet -> IO FC.CInt) fun_2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2170297251bf6d62 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a90e84da83866d0e" hs_bindgen_a90e84da83866d0e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt) -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a90e84da83866d0e" hs_bindgen_a90e84da83866d0e :: +hs_bindgen_a90e84da83866d0e :: IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt) -> IO FC.CInt)) +hs_bindgen_a90e84da83866d0e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a90e84da83866d0e_base {-# NOINLINE fun_3_ptr #-} @@ -285,10 +307,17 @@ fun_3_ptr :: Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.C fun_3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a90e84da83866d0e +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_93e48e07f9f40577" hs_bindgen_93e48e07f9f40577_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (List -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_93e48e07f9f40577" hs_bindgen_93e48e07f9f40577 :: +hs_bindgen_93e48e07f9f40577 :: IO (Ptr.FunPtr (List -> IO FC.CInt)) +hs_bindgen_93e48e07f9f40577 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_93e48e07f9f40577_base {-# NOINLINE fun_4_ptr #-} @@ -304,10 +333,17 @@ fun_4_ptr :: Ptr.FunPtr (List -> IO FC.CInt) fun_4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_93e48e07f9f40577 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3fadc044f8437855" hs_bindgen_3fadc044f8437855_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3fadc044f8437855" hs_bindgen_3fadc044f8437855 :: +hs_bindgen_3fadc044f8437855 :: IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt)) +hs_bindgen_3fadc044f8437855 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3fadc044f8437855_base {-# NOINLINE fun_5_ptr #-} @@ -323,10 +359,17 @@ fun_5_ptr :: Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((Hs fun_5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3fadc044f8437855 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4b116cc6e48e6c3b" hs_bindgen_4b116cc6e48e6c3b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Matrix -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_6_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4b116cc6e48e6c3b" hs_bindgen_4b116cc6e48e6c3b :: +hs_bindgen_4b116cc6e48e6c3b :: IO (Ptr.FunPtr (Matrix -> IO FC.CInt)) +hs_bindgen_4b116cc6e48e6c3b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4b116cc6e48e6c3b_base {-# NOINLINE fun_6_ptr #-} @@ -342,10 +385,17 @@ fun_6_ptr :: Ptr.FunPtr (Matrix -> IO FC.CInt) fun_6_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4b116cc6e48e6c3b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_27f76815dbc61f73" hs_bindgen_27f76815dbc61f73_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_7_ptr@ -} -foreign import ccall unsafe "hs_bindgen_27f76815dbc61f73" hs_bindgen_27f76815dbc61f73 :: +hs_bindgen_27f76815dbc61f73 :: IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt)) +hs_bindgen_27f76815dbc61f73 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_27f76815dbc61f73_base {-# NOINLINE fun_7_ptr #-} @@ -361,10 +411,17 @@ fun_7_ptr :: Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray ((Hs fun_7_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_27f76815dbc61f73 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a79b67b394d1dab8" hs_bindgen_a79b67b394d1dab8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Tripletlist -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_8_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a79b67b394d1dab8" hs_bindgen_a79b67b394d1dab8 :: +hs_bindgen_a79b67b394d1dab8 :: IO (Ptr.FunPtr (Tripletlist -> IO FC.CInt)) +hs_bindgen_a79b67b394d1dab8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a79b67b394d1dab8_base {-# NOINLINE fun_8_ptr #-} @@ -380,10 +437,17 @@ fun_8_ptr :: Ptr.FunPtr (Tripletlist -> IO FC.CInt) fun_8_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a79b67b394d1dab8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3035f04158da4ea8" hs_bindgen_3035f04158da4ea8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Sudoku -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_isSolved_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3035f04158da4ea8" hs_bindgen_3035f04158da4ea8 :: +hs_bindgen_3035f04158da4ea8 :: IO (Ptr.FunPtr (Sudoku -> IO FC.CInt)) +hs_bindgen_3035f04158da4ea8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3035f04158da4ea8_base {-# NOINLINE isSolved_ptr #-} @@ -399,10 +463,17 @@ isSolved_ptr :: Ptr.FunPtr (Sudoku -> IO FC.CInt) isSolved_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3035f04158da4ea8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4ca938a03ef0961a" hs_bindgen_4ca938a03ef0961a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_1_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4ca938a03ef0961a" hs_bindgen_4ca938a03ef0961a :: +hs_bindgen_4ca938a03ef0961a :: IO (Ptr.FunPtr (FC.CInt -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt)) +hs_bindgen_4ca938a03ef0961a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4ca938a03ef0961a_base {-# NOINLINE fun_1_const_ptr #-} @@ -418,10 +489,17 @@ fun_1_const_ptr :: Ptr.FunPtr (FC.CInt -> ((HsBindgen.Runtime.ConstantArray.Cons fun_1_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4ca938a03ef0961a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ab436eab87e0d868" hs_bindgen_ab436eab87e0d868_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Triplet -> Triplet -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_2_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ab436eab87e0d868" hs_bindgen_ab436eab87e0d868 :: +hs_bindgen_ab436eab87e0d868 :: IO (Ptr.FunPtr (Triplet -> Triplet -> IO FC.CInt)) +hs_bindgen_ab436eab87e0d868 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ab436eab87e0d868_base {-# NOINLINE fun_2_const_ptr #-} @@ -437,10 +515,17 @@ fun_2_const_ptr :: Ptr.FunPtr (Triplet -> Triplet -> IO FC.CInt) fun_2_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_ab436eab87e0d868 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_98d06bd5403ada68" hs_bindgen_98d06bd5403ada68_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt) -> (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt) -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_3_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_98d06bd5403ada68" hs_bindgen_98d06bd5403ada68 :: +hs_bindgen_98d06bd5403ada68 :: IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt) -> (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt) -> IO FC.CInt)) +hs_bindgen_98d06bd5403ada68 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_98d06bd5403ada68_base {-# NOINLINE fun_3_const_ptr #-} @@ -456,10 +541,17 @@ fun_3_const_ptr :: Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArra fun_3_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_98d06bd5403ada68 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_73a3249ecd4b2587" hs_bindgen_73a3249ecd4b2587_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (List -> List -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_4_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_73a3249ecd4b2587" hs_bindgen_73a3249ecd4b2587 :: +hs_bindgen_73a3249ecd4b2587 :: IO (Ptr.FunPtr (List -> List -> IO FC.CInt)) +hs_bindgen_73a3249ecd4b2587 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_73a3249ecd4b2587_base {-# NOINLINE fun_4_const_ptr #-} @@ -475,10 +567,17 @@ fun_4_const_ptr :: Ptr.FunPtr (List -> List -> IO FC.CInt) fun_4_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_73a3249ecd4b2587 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7a4270e16880a707" hs_bindgen_7a4270e16880a707_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_5_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7a4270e16880a707" hs_bindgen_7a4270e16880a707 :: +hs_bindgen_7a4270e16880a707 :: IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt)) +hs_bindgen_7a4270e16880a707 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7a4270e16880a707_base {-# NOINLINE fun_5_const_ptr #-} @@ -494,10 +593,17 @@ fun_5_const_ptr :: Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 4 fun_5_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7a4270e16880a707 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7d046eec920d0789" hs_bindgen_7d046eec920d0789_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Matrix -> Matrix -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_6_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7d046eec920d0789" hs_bindgen_7d046eec920d0789 :: +hs_bindgen_7d046eec920d0789 :: IO (Ptr.FunPtr (Matrix -> Matrix -> IO FC.CInt)) +hs_bindgen_7d046eec920d0789 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7d046eec920d0789_base {-# NOINLINE fun_6_const_ptr #-} @@ -513,10 +619,17 @@ fun_6_const_ptr :: Ptr.FunPtr (Matrix -> Matrix -> IO FC.CInt) fun_6_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7d046eec920d0789 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e60c9fdf601f4d52" hs_bindgen_e60c9fdf601f4d52_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_7_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e60c9fdf601f4d52" hs_bindgen_e60c9fdf601f4d52 :: +hs_bindgen_e60c9fdf601f4d52 :: IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt)) +hs_bindgen_e60c9fdf601f4d52 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e60c9fdf601f4d52_base {-# NOINLINE fun_7_const_ptr #-} @@ -532,10 +645,17 @@ fun_7_const_ptr :: Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArra fun_7_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e60c9fdf601f4d52 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_26377cb588f993f2" hs_bindgen_26377cb588f993f2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Tripletlist -> Tripletlist -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_fun_8_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_26377cb588f993f2" hs_bindgen_26377cb588f993f2 :: +hs_bindgen_26377cb588f993f2 :: IO (Ptr.FunPtr (Tripletlist -> Tripletlist -> IO FC.CInt)) +hs_bindgen_26377cb588f993f2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_26377cb588f993f2_base {-# NOINLINE fun_8_const_ptr #-} @@ -551,10 +671,17 @@ fun_8_const_ptr :: Ptr.FunPtr (Tripletlist -> Tripletlist -> IO FC.CInt) fun_8_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_26377cb588f993f2 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_525c462baff9c281" hs_bindgen_525c462baff9c281_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Sudoku -> Sudoku -> IO FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_isSolved_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_525c462baff9c281" hs_bindgen_525c462baff9c281 :: +hs_bindgen_525c462baff9c281 :: IO (Ptr.FunPtr (Sudoku -> Sudoku -> IO FC.CInt)) +hs_bindgen_525c462baff9c281 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_525c462baff9c281_base {-# NOINLINE isSolved_const_ptr #-} @@ -570,10 +697,17 @@ isSolved_const_ptr :: Ptr.FunPtr (Sudoku -> Sudoku -> IO FC.CInt) isSolved_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_525c462baff9c281 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1ee64a8054febdc1" hs_bindgen_1ee64a8054febdc1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))))) + {-| __unique:__ @test_arraysarray_Example_get_fun_9_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1ee64a8054febdc1" hs_bindgen_1ee64a8054febdc1 :: +hs_bindgen_1ee64a8054febdc1 :: IO (Ptr.FunPtr (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) +hs_bindgen_1ee64a8054febdc1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1ee64a8054febdc1_base {-# NOINLINE fun_9_ptr #-} @@ -589,10 +723,17 @@ fun_9_ptr :: Ptr.FunPtr (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantA fun_9_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1ee64a8054febdc1 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c8090d6b86a88ba0" hs_bindgen_c8090d6b86a88ba0_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.Ptr Triplet)))) + {-| __unique:__ @test_arraysarray_Example_get_fun_10_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c8090d6b86a88ba0" hs_bindgen_c8090d6b86a88ba0 :: +hs_bindgen_c8090d6b86a88ba0 :: IO (Ptr.FunPtr (IO (Ptr.Ptr Triplet))) +hs_bindgen_c8090d6b86a88ba0 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c8090d6b86a88ba0_base {-# NOINLINE fun_10_ptr #-} @@ -608,10 +749,17 @@ fun_10_ptr :: Ptr.FunPtr (IO (Ptr.Ptr Triplet)) fun_10_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c8090d6b86a88ba0 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4f90fd6464df2b20" hs_bindgen_4f90fd6464df2b20_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt))))) + {-| __unique:__ @test_arraysarray_Example_get_fun_11_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4f90fd6464df2b20" hs_bindgen_4f90fd6464df2b20 :: +hs_bindgen_4f90fd6464df2b20 :: IO (Ptr.FunPtr (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt)))) +hs_bindgen_4f90fd6464df2b20 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4f90fd6464df2b20_base {-# NOINLINE fun_11_ptr #-} @@ -627,10 +775,17 @@ fun_11_ptr :: Ptr.FunPtr (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.Incompl fun_11_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4f90fd6464df2b20 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4b4a73f20be545eb" hs_bindgen_4b4a73f20be545eb_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.Ptr List)))) + {-| __unique:__ @test_arraysarray_Example_get_fun_12_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4b4a73f20be545eb" hs_bindgen_4b4a73f20be545eb :: +hs_bindgen_4b4a73f20be545eb :: IO (Ptr.FunPtr (IO (Ptr.Ptr List))) +hs_bindgen_4b4a73f20be545eb = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4b4a73f20be545eb_base {-# NOINLINE fun_12_ptr #-} @@ -646,10 +801,17 @@ fun_12_ptr :: Ptr.FunPtr (IO (Ptr.Ptr List)) fun_12_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4b4a73f20be545eb +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a88be261251caf90" hs_bindgen_a88be261251caf90_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))))) + {-| __unique:__ @test_arraysarray_Example_get_fun_13_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a88be261251caf90" hs_bindgen_a88be261251caf90 :: +hs_bindgen_a88be261251caf90 :: IO (Ptr.FunPtr (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))))) +hs_bindgen_a88be261251caf90 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a88be261251caf90_base {-# NOINLINE fun_13_ptr #-} @@ -665,10 +827,17 @@ fun_13_ptr :: Ptr.FunPtr (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.Constant fun_13_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a88be261251caf90 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2f0a2188338306d9" hs_bindgen_2f0a2188338306d9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.Ptr Matrix)))) + {-| __unique:__ @test_arraysarray_Example_get_fun_14_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2f0a2188338306d9" hs_bindgen_2f0a2188338306d9 :: +hs_bindgen_2f0a2188338306d9 :: IO (Ptr.FunPtr (IO (Ptr.Ptr Matrix))) +hs_bindgen_2f0a2188338306d9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2f0a2188338306d9_base {-# NOINLINE fun_14_ptr #-} @@ -684,10 +853,17 @@ fun_14_ptr :: Ptr.FunPtr (IO (Ptr.Ptr Matrix)) fun_14_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2f0a2188338306d9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_30af82288a309775" hs_bindgen_30af82288a309775_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))))) + {-| __unique:__ @test_arraysarray_Example_get_fun_15_ptr@ -} -foreign import ccall unsafe "hs_bindgen_30af82288a309775" hs_bindgen_30af82288a309775 :: +hs_bindgen_30af82288a309775 :: IO (Ptr.FunPtr (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))))) +hs_bindgen_30af82288a309775 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_30af82288a309775_base {-# NOINLINE fun_15_ptr #-} @@ -703,10 +879,17 @@ fun_15_ptr :: Ptr.FunPtr (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.Incompl fun_15_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_30af82288a309775 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fb63d18d5d1004fb" hs_bindgen_fb63d18d5d1004fb_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.Ptr Tripletlist)))) + {-| __unique:__ @test_arraysarray_Example_get_fun_16_ptr@ -} -foreign import ccall unsafe "hs_bindgen_fb63d18d5d1004fb" hs_bindgen_fb63d18d5d1004fb :: +hs_bindgen_fb63d18d5d1004fb :: IO (Ptr.FunPtr (IO (Ptr.Ptr Tripletlist))) +hs_bindgen_fb63d18d5d1004fb = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_fb63d18d5d1004fb_base {-# NOINLINE fun_16_ptr #-} @@ -722,10 +905,17 @@ fun_16_ptr :: Ptr.FunPtr (IO (Ptr.Ptr Tripletlist)) fun_16_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_fb63d18d5d1004fb +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e7d751562a2e3c6c" hs_bindgen_e7d751562a2e3c6c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.Ptr Sudoku)))) + {-| __unique:__ @test_arraysarray_Example_get_solve_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e7d751562a2e3c6c" hs_bindgen_e7d751562a2e3c6c :: +hs_bindgen_e7d751562a2e3c6c :: IO (Ptr.FunPtr (IO (Ptr.Ptr Sudoku))) +hs_bindgen_e7d751562a2e3c6c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e7d751562a2e3c6c_base {-# NOINLINE solve_ptr #-} diff --git a/hs-bindgen/fixtures/arrays/array/Example/Global.hs b/hs-bindgen/fixtures/arrays/array/Example/Global.hs index 98436065f..cc9d44552 100644 --- a/hs-bindgen/fixtures/arrays/array/Example/Global.hs +++ b/hs-bindgen/fixtures/arrays/array/Example/Global.hs @@ -11,6 +11,7 @@ import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude import Example @@ -152,10 +153,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dd2a346b95b769db" hs_bindgen_dd2a346b95b769db_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr0_ptr@ -} -foreign import ccall unsafe "hs_bindgen_dd2a346b95b769db" hs_bindgen_dd2a346b95b769db :: +hs_bindgen_dd2a346b95b769db :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) +hs_bindgen_dd2a346b95b769db = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_dd2a346b95b769db_base {-# NOINLINE arr0_ptr #-} @@ -171,10 +179,17 @@ arr0_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) arr0_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_dd2a346b95b769db +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3867a46f740e141f" hs_bindgen_3867a46f740e141f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3867a46f740e141f" hs_bindgen_3867a46f740e141f :: +hs_bindgen_3867a46f740e141f :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) +hs_bindgen_3867a46f740e141f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3867a46f740e141f_base {-# NOINLINE arr1_ptr #-} @@ -190,10 +205,17 @@ arr1_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) arr1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3867a46f740e141f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c1b5868da3cfebbe" hs_bindgen_c1b5868da3cfebbe_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c1b5868da3cfebbe" hs_bindgen_c1b5868da3cfebbe :: +hs_bindgen_c1b5868da3cfebbe :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) +hs_bindgen_c1b5868da3cfebbe = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c1b5868da3cfebbe_base {-# NOINLINE arr2_ptr #-} @@ -209,10 +231,17 @@ arr2_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) arr2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c1b5868da3cfebbe +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_697b55cf10c5c7ae" hs_bindgen_697b55cf10c5c7ae_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_697b55cf10c5c7ae" hs_bindgen_697b55cf10c5c7ae :: +hs_bindgen_697b55cf10c5c7ae :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) +hs_bindgen_697b55cf10c5c7ae = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_697b55cf10c5c7ae_base {-# NOINLINE arr3_ptr #-} @@ -228,10 +257,17 @@ arr3_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) arr3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_697b55cf10c5c7ae +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f935cbe0a13b4987" hs_bindgen_f935cbe0a13b4987_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 1) FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr6_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f935cbe0a13b4987" hs_bindgen_f935cbe0a13b4987 :: +hs_bindgen_f935cbe0a13b4987 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 1) FC.CInt)) +hs_bindgen_f935cbe0a13b4987 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f935cbe0a13b4987_base {-# NOINLINE arr6_ptr #-} @@ -247,10 +283,17 @@ arr6_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 1) FC.CInt) arr6_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f935cbe0a13b4987 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_673085071176d81a" hs_bindgen_673085071176d81a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr7_ptr@ -} -foreign import ccall unsafe "hs_bindgen_673085071176d81a" hs_bindgen_673085071176d81a :: +hs_bindgen_673085071176d81a :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt)) +hs_bindgen_673085071176d81a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_673085071176d81a_base {-# NOINLINE arr7_ptr #-} @@ -266,10 +309,17 @@ arr7_ptr :: Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt) arr7_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_673085071176d81a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3cf195887769eb3d" hs_bindgen_3cf195887769eb3d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr_1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3cf195887769eb3d" hs_bindgen_3cf195887769eb3d :: +hs_bindgen_3cf195887769eb3d :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) +hs_bindgen_3cf195887769eb3d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3cf195887769eb3d_base {-# NOINLINE arr_1_ptr #-} @@ -285,10 +335,17 @@ arr_1_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) arr_1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3cf195887769eb3d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4621cb499a2b4cd3" hs_bindgen_4621cb499a2b4cd3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Triplet)) + {-| __unique:__ @test_arraysarray_Example_get_arr_2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4621cb499a2b4cd3" hs_bindgen_4621cb499a2b4cd3 :: +hs_bindgen_4621cb499a2b4cd3 :: IO (Ptr.Ptr Triplet) +hs_bindgen_4621cb499a2b4cd3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4621cb499a2b4cd3_base {-# NOINLINE arr_2_ptr #-} @@ -304,10 +361,17 @@ arr_2_ptr :: Ptr.Ptr Triplet arr_2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4621cb499a2b4cd3 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cb7148df8f0668ef" hs_bindgen_cb7148df8f0668ef_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr_3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_cb7148df8f0668ef" hs_bindgen_cb7148df8f0668ef :: +hs_bindgen_cb7148df8f0668ef :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt)) +hs_bindgen_cb7148df8f0668ef = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_cb7148df8f0668ef_base {-# NOINLINE arr_3_ptr #-} @@ -323,10 +387,17 @@ arr_3_ptr :: Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt) arr_3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_cb7148df8f0668ef +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f0a4984c74b89803" hs_bindgen_f0a4984c74b89803_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr List)) + {-| __unique:__ @test_arraysarray_Example_get_arr_4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f0a4984c74b89803" hs_bindgen_f0a4984c74b89803 :: +hs_bindgen_f0a4984c74b89803 :: IO (Ptr.Ptr List) +hs_bindgen_f0a4984c74b89803 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f0a4984c74b89803_base {-# NOINLINE arr_4_ptr #-} @@ -342,10 +413,17 @@ arr_4_ptr :: Ptr.Ptr List arr_4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f0a4984c74b89803 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9f555ad1567e295a" hs_bindgen_9f555ad1567e295a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) + {-| __unique:__ @test_arraysarray_Example_get_arr_5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9f555ad1567e295a" hs_bindgen_9f555ad1567e295a :: +hs_bindgen_9f555ad1567e295a :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +hs_bindgen_9f555ad1567e295a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9f555ad1567e295a_base {-# NOINLINE arr_5_ptr #-} @@ -361,10 +439,17 @@ arr_5_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBind arr_5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9f555ad1567e295a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f016939597566966" hs_bindgen_f016939597566966_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Matrix)) + {-| __unique:__ @test_arraysarray_Example_get_arr_6_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f016939597566966" hs_bindgen_f016939597566966 :: +hs_bindgen_f016939597566966 :: IO (Ptr.Ptr Matrix) +hs_bindgen_f016939597566966 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f016939597566966_base {-# NOINLINE arr_6_ptr #-} @@ -380,10 +465,17 @@ arr_6_ptr :: Ptr.Ptr Matrix arr_6_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f016939597566966 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bb1876e9c2ece223" hs_bindgen_bb1876e9c2ece223_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) + {-| __unique:__ @test_arraysarray_Example_get_arr_7_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bb1876e9c2ece223" hs_bindgen_bb1876e9c2ece223 :: +hs_bindgen_bb1876e9c2ece223 :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +hs_bindgen_bb1876e9c2ece223 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bb1876e9c2ece223_base {-# NOINLINE arr_7_ptr #-} @@ -399,10 +491,17 @@ arr_7_ptr :: Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBind arr_7_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bb1876e9c2ece223 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dc2a31e3f871adec" hs_bindgen_dc2a31e3f871adec_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Tripletlist)) + {-| __unique:__ @test_arraysarray_Example_get_arr_8_ptr@ -} -foreign import ccall unsafe "hs_bindgen_dc2a31e3f871adec" hs_bindgen_dc2a31e3f871adec :: +hs_bindgen_dc2a31e3f871adec :: IO (Ptr.Ptr Tripletlist) +hs_bindgen_dc2a31e3f871adec = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_dc2a31e3f871adec_base {-# NOINLINE arr_8_ptr #-} @@ -418,10 +517,17 @@ arr_8_ptr :: Ptr.Ptr Tripletlist arr_8_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_dc2a31e3f871adec +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fc9438d00f745eee" hs_bindgen_fc9438d00f745eee_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr_1_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_fc9438d00f745eee" hs_bindgen_fc9438d00f745eee :: +hs_bindgen_fc9438d00f745eee :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) +hs_bindgen_fc9438d00f745eee = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_fc9438d00f745eee_base {-# NOINLINE arr_1_const_ptr #-} @@ -443,10 +549,17 @@ arr_1_const :: (HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt arr_1_const = GHC.IO.Unsafe.unsafePerformIO (F.peek arr_1_const_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_be3eba6be1a73c5d" hs_bindgen_be3eba6be1a73c5d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Triplet)) + {-| __unique:__ @test_arraysarray_Example_get_arr_2_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_be3eba6be1a73c5d" hs_bindgen_be3eba6be1a73c5d :: +hs_bindgen_be3eba6be1a73c5d :: IO (Ptr.Ptr Triplet) +hs_bindgen_be3eba6be1a73c5d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_be3eba6be1a73c5d_base {-# NOINLINE arr_2_const_ptr #-} @@ -468,10 +581,17 @@ arr_2_const :: Triplet arr_2_const = GHC.IO.Unsafe.unsafePerformIO (F.peek arr_2_const_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0c3c415a6bdd56a6" hs_bindgen_0c3c415a6bdd56a6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt))) + {-| __unique:__ @test_arraysarray_Example_get_arr_3_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_0c3c415a6bdd56a6" hs_bindgen_0c3c415a6bdd56a6 :: +hs_bindgen_0c3c415a6bdd56a6 :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt)) +hs_bindgen_0c3c415a6bdd56a6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_0c3c415a6bdd56a6_base {-# NOINLINE arr_3_const_ptr #-} @@ -487,10 +607,17 @@ arr_3_const_ptr :: Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC arr_3_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_0c3c415a6bdd56a6 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a6fa7483b9d48043" hs_bindgen_a6fa7483b9d48043_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr List)) + {-| __unique:__ @test_arraysarray_Example_get_arr_4_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a6fa7483b9d48043" hs_bindgen_a6fa7483b9d48043 :: +hs_bindgen_a6fa7483b9d48043 :: IO (Ptr.Ptr List) +hs_bindgen_a6fa7483b9d48043 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a6fa7483b9d48043_base {-# NOINLINE arr_4_const_ptr #-} @@ -506,10 +633,17 @@ arr_4_const_ptr :: Ptr.Ptr List arr_4_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a6fa7483b9d48043 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_93b436ac5ffd8c82" hs_bindgen_93b436ac5ffd8c82_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) + {-| __unique:__ @test_arraysarray_Example_get_arr_5_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_93b436ac5ffd8c82" hs_bindgen_93b436ac5ffd8c82 :: +hs_bindgen_93b436ac5ffd8c82 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +hs_bindgen_93b436ac5ffd8c82 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_93b436ac5ffd8c82_base {-# NOINLINE arr_5_const_ptr #-} @@ -531,10 +665,17 @@ arr_5_const :: (HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Run arr_5_const = GHC.IO.Unsafe.unsafePerformIO (F.peek arr_5_const_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9e625256c9dc1a3f" hs_bindgen_9e625256c9dc1a3f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Matrix)) + {-| __unique:__ @test_arraysarray_Example_get_arr_6_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9e625256c9dc1a3f" hs_bindgen_9e625256c9dc1a3f :: +hs_bindgen_9e625256c9dc1a3f :: IO (Ptr.Ptr Matrix) +hs_bindgen_9e625256c9dc1a3f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9e625256c9dc1a3f_base {-# NOINLINE arr_6_const_ptr #-} @@ -556,10 +697,17 @@ arr_6_const :: Matrix arr_6_const = GHC.IO.Unsafe.unsafePerformIO (F.peek arr_6_const_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_19cc3c6537ef51f0" hs_bindgen_19cc3c6537ef51f0_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) + {-| __unique:__ @test_arraysarray_Example_get_arr_7_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_19cc3c6537ef51f0" hs_bindgen_19cc3c6537ef51f0 :: +hs_bindgen_19cc3c6537ef51f0 :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +hs_bindgen_19cc3c6537ef51f0 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_19cc3c6537ef51f0_base {-# NOINLINE arr_7_const_ptr #-} @@ -575,10 +723,17 @@ arr_7_const_ptr :: Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray (( arr_7_const_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_19cc3c6537ef51f0 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9af0285a476aaf26" hs_bindgen_9af0285a476aaf26_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Tripletlist)) + {-| __unique:__ @test_arraysarray_Example_get_arr_8_const_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9af0285a476aaf26" hs_bindgen_9af0285a476aaf26 :: +hs_bindgen_9af0285a476aaf26 :: IO (Ptr.Ptr Tripletlist) +hs_bindgen_9af0285a476aaf26 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9af0285a476aaf26_base {-# NOINLINE arr_8_const_ptr #-} diff --git a/hs-bindgen/fixtures/arrays/array/Example/Safe.hs b/hs-bindgen/fixtures/arrays/array/Example/Safe.hs index 5185a32df..c637478ed 100644 --- a/hs-bindgen/fixtures/arrays/array/Example/Safe.hs +++ b/hs-bindgen/fixtures/arrays/array/Example/Safe.hs @@ -9,6 +9,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude import Example @@ -173,6 +174,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a836491d63ff3a2c" fun_1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) + {-| Array of known size __C declaration:__ @fun_1@ @@ -183,7 +189,7 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_1@ -} -foreign import ccall safe "hs_bindgen_a836491d63ff3a2c" fun_1 :: +fun_1 :: FC.CInt {- ^ __C declaration:__ @x@ -} @@ -191,6 +197,13 @@ foreign import ccall safe "hs_bindgen_a836491d63ff3a2c" fun_1 :: {- ^ __C declaration:__ @xs@ -} -> IO FC.CInt +fun_1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c69f41e5ccc441ab" fun_2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> IO FC.CInt) {-| Array of known size, typedef @@ -202,11 +215,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_2@ -} -foreign import ccall safe "hs_bindgen_c69f41e5ccc441ab" fun_2 :: +fun_2 :: Ptr.Ptr FC.CInt {- ^ __C declaration:__ @xs@ -} -> IO FC.CInt +fun_2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_30065ddbffdd7502" fun_3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> IO FC.CInt) {-| Array of unknown size @@ -218,11 +238,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_3@ -} -foreign import ccall safe "hs_bindgen_30065ddbffdd7502" fun_3 :: +fun_3 :: Ptr.Ptr FC.CInt {- ^ __C declaration:__ @xs@ -} -> IO FC.CInt +fun_3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6e8db8abcb5fe22a" fun_4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> IO FC.CInt) {-| Array of unknown size, typedef @@ -234,11 +261,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_4@ -} -foreign import ccall safe "hs_bindgen_6e8db8abcb5fe22a" fun_4 :: +fun_4 :: Ptr.Ptr FC.CInt {- ^ __C declaration:__ @xs@ -} -> IO FC.CInt +fun_4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_4_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b2f48c31265a3f47" fun_5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) {-| Multi-dimensional array of known size @@ -250,11 +284,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_5@ -} -foreign import ccall safe "hs_bindgen_b2f48c31265a3f47" fun_5 :: +fun_5 :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +fun_5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_5_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_343fe8ca0dbb7eb1" fun_6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) {-| Multi-dimensional array of known size, typedef @@ -266,11 +307,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_6@ -} -foreign import ccall safe "hs_bindgen_343fe8ca0dbb7eb1" fun_6 :: +fun_6 :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +fun_6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_6_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d98a58d39b578fd6" fun_7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) {-| Multi-dimensional array of unknown size @@ -282,11 +330,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_7@ -} -foreign import ccall safe "hs_bindgen_d98a58d39b578fd6" fun_7 :: +fun_7 :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +fun_7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_7_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4db12be6f46d98f5" fun_8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) {-| Multi-dimensional array of unknown size, typedef @@ -298,11 +353,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_8@ -} -foreign import ccall safe "hs_bindgen_4db12be6f46d98f5" fun_8 :: +fun_8 :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +fun_8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_8_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_825f9aeca071df21" isSolved_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Triplet) -> IO FC.CInt) {-| Typedef-in-typedef @@ -314,21 +376,30 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_isSolved@ -} -foreign import ccall safe "hs_bindgen_825f9aeca071df21" isSolved :: +isSolved :: Ptr.Ptr Triplet {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +isSolved = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType isSolved_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a2bf6bc667c9e769" fun_1_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr FC.CInt) -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) {-| Pointer-based API for 'fun_1_const' __unique:__ @test_arraysarray_Example_Safe_fun_1_const@ -} -foreign import ccall safe "hs_bindgen_a2bf6bc667c9e769" fun_1_const_wrapper :: +fun_1_const_wrapper :: FC.CInt -> Ptr.Ptr FC.CInt -> Ptr.Ptr FC.CInt -> IO FC.CInt +fun_1_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_1_const_wrapper_base {-| Array of known size @@ -356,14 +427,21 @@ fun_1_const = HsBindgen.Runtime.ConstantArray.withPtr x2 (\ptr3 -> fun_1_const_wrapper x0 x1 ptr3) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ec5a6dd15a457a1d" fun_2_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) + {-| Pointer-based API for 'fun_2_const' __unique:__ @test_arraysarray_Example_Safe_fun_2_const@ -} -foreign import ccall safe "hs_bindgen_ec5a6dd15a457a1d" fun_2_const_wrapper :: +fun_2_const_wrapper :: Ptr.Ptr FC.CInt -> Ptr.Ptr FC.CInt -> IO FC.CInt +fun_2_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_2_const_wrapper_base {-| Array of known size, typedef @@ -387,14 +465,21 @@ fun_2_const = HsBindgen.Runtime.ConstantArray.withPtr x1 (\ptr2 -> fun_2_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_84df1030280611db" fun_3_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) + {-| Pointer-based API for 'fun_3_const' __unique:__ @test_arraysarray_Example_Safe_fun_3_const@ -} -foreign import ccall safe "hs_bindgen_84df1030280611db" fun_3_const_wrapper :: +fun_3_const_wrapper :: Ptr.Ptr FC.CInt -> Ptr.Ptr FC.CInt -> IO FC.CInt +fun_3_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_3_const_wrapper_base {-| Array of unknown size @@ -418,14 +503,21 @@ fun_3_const = HsBindgen.Runtime.IncompleteArray.withPtr x1 (\ptr2 -> fun_3_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e9dc927aa39d14d3" fun_4_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) + {-| Pointer-based API for 'fun_4_const' __unique:__ @test_arraysarray_Example_Safe_fun_4_const@ -} -foreign import ccall safe "hs_bindgen_e9dc927aa39d14d3" fun_4_const_wrapper :: +fun_4_const_wrapper :: Ptr.Ptr FC.CInt -> Ptr.Ptr FC.CInt -> IO FC.CInt +fun_4_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_4_const_wrapper_base {-| Array of unknown size, typedef @@ -449,14 +541,21 @@ fun_4_const = HsBindgen.Runtime.IncompleteArray.withPtr x1 (\ptr2 -> fun_4_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cd0bfb26f385dfaa" fun_5_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) + {-| Pointer-based API for 'fun_5_const' __unique:__ @test_arraysarray_Example_Safe_fun_5_const@ -} -foreign import ccall safe "hs_bindgen_cd0bfb26f385dfaa" fun_5_const_wrapper :: +fun_5_const_wrapper :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt +fun_5_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_5_const_wrapper_base {-| Multi-dimensional array of known size @@ -480,14 +579,21 @@ fun_5_const = HsBindgen.Runtime.ConstantArray.withPtr x1 (\ptr2 -> fun_5_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1054ce6b48ed0f13" fun_6_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) + {-| Pointer-based API for 'fun_6_const' __unique:__ @test_arraysarray_Example_Safe_fun_6_const@ -} -foreign import ccall safe "hs_bindgen_1054ce6b48ed0f13" fun_6_const_wrapper :: +fun_6_const_wrapper :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt +fun_6_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_6_const_wrapper_base {-| Multi-dimensional array of known size, typedef @@ -511,14 +617,21 @@ fun_6_const = HsBindgen.Runtime.ConstantArray.withPtr x1 (\ptr2 -> fun_6_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_496902d7c6466098" fun_7_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) + {-| Pointer-based API for 'fun_7_const' __unique:__ @test_arraysarray_Example_Safe_fun_7_const@ -} -foreign import ccall safe "hs_bindgen_496902d7c6466098" fun_7_const_wrapper :: +fun_7_const_wrapper :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt +fun_7_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_7_const_wrapper_base {-| Multi-dimensional array of unknown size @@ -542,14 +655,21 @@ fun_7_const = HsBindgen.Runtime.IncompleteArray.withPtr x1 (\ptr2 -> fun_7_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eb65cb5074167c48" fun_8_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) + {-| Pointer-based API for 'fun_8_const' __unique:__ @test_arraysarray_Example_Safe_fun_8_const@ -} -foreign import ccall safe "hs_bindgen_eb65cb5074167c48" fun_8_const_wrapper :: +fun_8_const_wrapper :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt +fun_8_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_8_const_wrapper_base {-| Multi-dimensional array of unknown size, typedef @@ -573,14 +693,21 @@ fun_8_const = HsBindgen.Runtime.IncompleteArray.withPtr x1 (\ptr2 -> fun_8_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9bb064e9eddf07f7" isSolved_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Triplet) -> (Ptr.Ptr Triplet) -> IO FC.CInt) + {-| Pointer-based API for 'isSolved_const' __unique:__ @test_arraysarray_Example_Safe_isSolved_const@ -} -foreign import ccall safe "hs_bindgen_9bb064e9eddf07f7" isSolved_const_wrapper :: +isSolved_const_wrapper :: Ptr.Ptr Triplet -> Ptr.Ptr Triplet -> IO FC.CInt +isSolved_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType isSolved_const_wrapper_base {-| Typedef-in-typedef @@ -604,6 +731,11 @@ isSolved_const = HsBindgen.Runtime.ConstantArray.withPtr x1 (\ptr2 -> isSolved_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0fa0a3e47fa9d95a" fun_9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) + {-| Array of known size __C declaration:__ @fun_9@ @@ -614,8 +746,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_9@ -} -foreign import ccall safe "hs_bindgen_0fa0a3e47fa9d95a" fun_9 :: +fun_9 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) +fun_9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_9_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e9d3d35727502125" fun_10_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Triplet)) {-| Array of known size, typedef @@ -627,8 +766,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_10@ -} -foreign import ccall safe "hs_bindgen_e9d3d35727502125" fun_10 :: +fun_10 :: IO (Ptr.Ptr Triplet) +fun_10 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_10_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7f7cea54b33bf176" fun_11_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt))) {-| Array of unknown size @@ -640,8 +786,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_11@ -} -foreign import ccall safe "hs_bindgen_7f7cea54b33bf176" fun_11 :: +fun_11 :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt)) +fun_11 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_11_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3124a96b00bbc082" fun_12_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr List)) {-| Array of unknown size, typedef @@ -653,8 +806,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_12@ -} -foreign import ccall safe "hs_bindgen_3124a96b00bbc082" fun_12 :: +fun_12 :: IO (Ptr.Ptr List) +fun_12 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_12_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2fdd1bf9ee687f9b" fun_13_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) {-| Multi-dimensional array of known size @@ -666,8 +826,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_13@ -} -foreign import ccall safe "hs_bindgen_2fdd1bf9ee687f9b" fun_13 :: +fun_13 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +fun_13 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_13_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_12a242894a3d45cb" fun_14_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Matrix)) {-| Multi-dimensional array of known size, typedef @@ -679,8 +846,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_14@ -} -foreign import ccall safe "hs_bindgen_12a242894a3d45cb" fun_14 :: +fun_14 :: IO (Ptr.Ptr Matrix) +fun_14 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_14_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d8e176eb5efefa2c" fun_15_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) {-| Multi-dimensional array of unknown size @@ -692,8 +866,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_15@ -} -foreign import ccall safe "hs_bindgen_d8e176eb5efefa2c" fun_15 :: +fun_15 :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +fun_15 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_15_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dcf234ca786626c7" fun_16_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Tripletlist)) {-| Multi-dimensional array of unknown size, typedef @@ -705,8 +886,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_fun_16@ -} -foreign import ccall safe "hs_bindgen_dcf234ca786626c7" fun_16 :: +fun_16 :: IO (Ptr.Ptr Tripletlist) +fun_16 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_16_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f80a5b6a2770c658" solve_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Sudoku)) {-| Typedef-in-typedef @@ -718,5 +906,7 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Safe_solve@ -} -foreign import ccall safe "hs_bindgen_f80a5b6a2770c658" solve :: +solve :: IO (Ptr.Ptr Sudoku) +solve = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType solve_base diff --git a/hs-bindgen/fixtures/arrays/array/Example/Unsafe.hs b/hs-bindgen/fixtures/arrays/array/Example/Unsafe.hs index 8858fef5f..5a96661be 100644 --- a/hs-bindgen/fixtures/arrays/array/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/arrays/array/Example/Unsafe.hs @@ -9,6 +9,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude import Example @@ -173,6 +174,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6d07a0b03f884547" fun_1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) + {-| Array of known size __C declaration:__ @fun_1@ @@ -183,7 +189,7 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_1@ -} -foreign import ccall unsafe "hs_bindgen_6d07a0b03f884547" fun_1 :: +fun_1 :: FC.CInt {- ^ __C declaration:__ @x@ -} @@ -191,6 +197,13 @@ foreign import ccall unsafe "hs_bindgen_6d07a0b03f884547" fun_1 :: {- ^ __C declaration:__ @xs@ -} -> IO FC.CInt +fun_1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_04318f98a3ab8d08" fun_2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> IO FC.CInt) {-| Array of known size, typedef @@ -202,11 +215,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_2@ -} -foreign import ccall unsafe "hs_bindgen_04318f98a3ab8d08" fun_2 :: +fun_2 :: Ptr.Ptr FC.CInt {- ^ __C declaration:__ @xs@ -} -> IO FC.CInt +fun_2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2a7c5fa1040fa8db" fun_3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> IO FC.CInt) {-| Array of unknown size @@ -218,11 +238,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_3@ -} -foreign import ccall unsafe "hs_bindgen_2a7c5fa1040fa8db" fun_3 :: +fun_3 :: Ptr.Ptr FC.CInt {- ^ __C declaration:__ @xs@ -} -> IO FC.CInt +fun_3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_810acc5cf8729d0e" fun_4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> IO FC.CInt) {-| Array of unknown size, typedef @@ -234,11 +261,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_4@ -} -foreign import ccall unsafe "hs_bindgen_810acc5cf8729d0e" fun_4 :: +fun_4 :: Ptr.Ptr FC.CInt {- ^ __C declaration:__ @xs@ -} -> IO FC.CInt +fun_4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_4_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_83b71f7defb3b27a" fun_5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) {-| Multi-dimensional array of known size @@ -250,11 +284,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_5@ -} -foreign import ccall unsafe "hs_bindgen_83b71f7defb3b27a" fun_5 :: +fun_5 :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +fun_5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_5_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_62b76af3dc65da3f" fun_6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) {-| Multi-dimensional array of known size, typedef @@ -266,11 +307,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_6@ -} -foreign import ccall unsafe "hs_bindgen_62b76af3dc65da3f" fun_6 :: +fun_6 :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +fun_6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_6_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_100aa7fb87a5ea74" fun_7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) {-| Multi-dimensional array of unknown size @@ -282,11 +330,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_7@ -} -foreign import ccall unsafe "hs_bindgen_100aa7fb87a5ea74" fun_7 :: +fun_7 :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +fun_7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_7_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cd6646babeacd609" fun_8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) {-| Multi-dimensional array of unknown size, typedef @@ -298,11 +353,18 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_8@ -} -foreign import ccall unsafe "hs_bindgen_cd6646babeacd609" fun_8 :: +fun_8 :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +fun_8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_8_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_560f1de9a83c3a6a" isSolved_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Triplet) -> IO FC.CInt) {-| Typedef-in-typedef @@ -314,21 +376,30 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_isSolved@ -} -foreign import ccall unsafe "hs_bindgen_560f1de9a83c3a6a" isSolved :: +isSolved :: Ptr.Ptr Triplet {- ^ __C declaration:__ @xss@ -} -> IO FC.CInt +isSolved = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType isSolved_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ef3b85ae74bc06cf" fun_1_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr FC.CInt) -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) {-| Pointer-based API for 'fun_1_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_1_const@ -} -foreign import ccall unsafe "hs_bindgen_ef3b85ae74bc06cf" fun_1_const_wrapper :: +fun_1_const_wrapper :: FC.CInt -> Ptr.Ptr FC.CInt -> Ptr.Ptr FC.CInt -> IO FC.CInt +fun_1_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_1_const_wrapper_base {-| Array of known size @@ -356,14 +427,21 @@ fun_1_const = HsBindgen.Runtime.ConstantArray.withPtr x2 (\ptr3 -> fun_1_const_wrapper x0 x1 ptr3) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1c913685e5e76952" fun_2_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) + {-| Pointer-based API for 'fun_2_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_2_const@ -} -foreign import ccall unsafe "hs_bindgen_1c913685e5e76952" fun_2_const_wrapper :: +fun_2_const_wrapper :: Ptr.Ptr FC.CInt -> Ptr.Ptr FC.CInt -> IO FC.CInt +fun_2_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_2_const_wrapper_base {-| Array of known size, typedef @@ -387,14 +465,21 @@ fun_2_const = HsBindgen.Runtime.ConstantArray.withPtr x1 (\ptr2 -> fun_2_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_eb8daf22bd5c6f00" fun_3_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) + {-| Pointer-based API for 'fun_3_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_3_const@ -} -foreign import ccall unsafe "hs_bindgen_eb8daf22bd5c6f00" fun_3_const_wrapper :: +fun_3_const_wrapper :: Ptr.Ptr FC.CInt -> Ptr.Ptr FC.CInt -> IO FC.CInt +fun_3_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_3_const_wrapper_base {-| Array of unknown size @@ -418,14 +503,21 @@ fun_3_const = HsBindgen.Runtime.IncompleteArray.withPtr x1 (\ptr2 -> fun_3_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0b73e4c7695a3b2f" fun_4_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CInt) -> (Ptr.Ptr FC.CInt) -> IO FC.CInt) + {-| Pointer-based API for 'fun_4_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_4_const@ -} -foreign import ccall unsafe "hs_bindgen_0b73e4c7695a3b2f" fun_4_const_wrapper :: +fun_4_const_wrapper :: Ptr.Ptr FC.CInt -> Ptr.Ptr FC.CInt -> IO FC.CInt +fun_4_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_4_const_wrapper_base {-| Array of unknown size, typedef @@ -449,14 +541,21 @@ fun_4_const = HsBindgen.Runtime.IncompleteArray.withPtr x1 (\ptr2 -> fun_4_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_374feb8086895fe3" fun_5_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) + {-| Pointer-based API for 'fun_5_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_5_const@ -} -foreign import ccall unsafe "hs_bindgen_374feb8086895fe3" fun_5_const_wrapper :: +fun_5_const_wrapper :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt +fun_5_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_5_const_wrapper_base {-| Multi-dimensional array of known size @@ -480,14 +579,21 @@ fun_5_const = HsBindgen.Runtime.ConstantArray.withPtr x1 (\ptr2 -> fun_5_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2d1320b468c36708" fun_6_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) + {-| Pointer-based API for 'fun_6_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_6_const@ -} -foreign import ccall unsafe "hs_bindgen_2d1320b468c36708" fun_6_const_wrapper :: +fun_6_const_wrapper :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt +fun_6_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_6_const_wrapper_base {-| Multi-dimensional array of known size, typedef @@ -511,14 +617,21 @@ fun_6_const = HsBindgen.Runtime.ConstantArray.withPtr x1 (\ptr2 -> fun_6_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f67f5fe5bfb57aa1" fun_7_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) + {-| Pointer-based API for 'fun_7_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_7_const@ -} -foreign import ccall unsafe "hs_bindgen_f67f5fe5bfb57aa1" fun_7_const_wrapper :: +fun_7_const_wrapper :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt +fun_7_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_7_const_wrapper_base {-| Multi-dimensional array of unknown size @@ -542,14 +655,21 @@ fun_7_const = HsBindgen.Runtime.IncompleteArray.withPtr x1 (\ptr2 -> fun_7_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2c9356851d76320e" fun_8_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) -> IO FC.CInt) + {-| Pointer-based API for 'fun_8_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_8_const@ -} -foreign import ccall unsafe "hs_bindgen_2c9356851d76320e" fun_8_const_wrapper :: +fun_8_const_wrapper :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) -> IO FC.CInt +fun_8_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_8_const_wrapper_base {-| Multi-dimensional array of unknown size, typedef @@ -573,14 +693,21 @@ fun_8_const = HsBindgen.Runtime.IncompleteArray.withPtr x1 (\ptr2 -> fun_8_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_39b08b64fed0c5b8" isSolved_const_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Triplet) -> (Ptr.Ptr Triplet) -> IO FC.CInt) + {-| Pointer-based API for 'isSolved_const' __unique:__ @test_arraysarray_Example_Unsafe_isSolved_const@ -} -foreign import ccall unsafe "hs_bindgen_39b08b64fed0c5b8" isSolved_const_wrapper :: +isSolved_const_wrapper :: Ptr.Ptr Triplet -> Ptr.Ptr Triplet -> IO FC.CInt +isSolved_const_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType isSolved_const_wrapper_base {-| Typedef-in-typedef @@ -604,6 +731,11 @@ isSolved_const = HsBindgen.Runtime.ConstantArray.withPtr x1 (\ptr2 -> isSolved_const_wrapper x0 ptr2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ab431ebc0519545a" fun_9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) + {-| Array of known size __C declaration:__ @fun_9@ @@ -614,8 +746,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_9@ -} -foreign import ccall unsafe "hs_bindgen_ab431ebc0519545a" fun_9 :: +fun_9 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) +fun_9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_9_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c9ff623e6f48d3bc" fun_10_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Triplet)) {-| Array of known size, typedef @@ -627,8 +766,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_10@ -} -foreign import ccall unsafe "hs_bindgen_c9ff623e6f48d3bc" fun_10 :: +fun_10 :: IO (Ptr.Ptr Triplet) +fun_10 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_10_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e714f0b7c764ba17" fun_11_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt))) {-| Array of unknown size @@ -640,8 +786,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_11@ -} -foreign import ccall unsafe "hs_bindgen_e714f0b7c764ba17" fun_11 :: +fun_11 :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt)) +fun_11 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_11_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cc23741700ba18f7" fun_12_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr List)) {-| Array of unknown size, typedef @@ -653,8 +806,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_12@ -} -foreign import ccall unsafe "hs_bindgen_cc23741700ba18f7" fun_12 :: +fun_12 :: IO (Ptr.Ptr List) +fun_12 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_12_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_eb3a1364003829ac" fun_13_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) {-| Multi-dimensional array of known size @@ -666,8 +826,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_13@ -} -foreign import ccall unsafe "hs_bindgen_eb3a1364003829ac" fun_13 :: +fun_13 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +fun_13 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_13_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0f49ffbe2c13ab46" fun_14_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Matrix)) {-| Multi-dimensional array of known size, typedef @@ -679,8 +846,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_14@ -} -foreign import ccall unsafe "hs_bindgen_0f49ffbe2c13ab46" fun_14 :: +fun_14 :: IO (Ptr.Ptr Matrix) +fun_14 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_14_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_59de769fbba4ed72" fun_15_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) {-| Multi-dimensional array of unknown size @@ -692,8 +866,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_15@ -} -foreign import ccall unsafe "hs_bindgen_59de769fbba4ed72" fun_15 :: +fun_15 :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +fun_15 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_15_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1d6ecccfa4ee16ff" fun_16_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Tripletlist)) {-| Multi-dimensional array of unknown size, typedef @@ -705,8 +886,15 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_16@ -} -foreign import ccall unsafe "hs_bindgen_1d6ecccfa4ee16ff" fun_16 :: +fun_16 :: IO (Ptr.Ptr Tripletlist) +fun_16 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_16_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6165085eab7d2806" solve_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Sudoku)) {-| Typedef-in-typedef @@ -718,5 +906,7 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_solve@ -} -foreign import ccall unsafe "hs_bindgen_6165085eab7d2806" solve :: +solve :: IO (Ptr.Ptr Sudoku) +solve = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType solve_base diff --git a/hs-bindgen/fixtures/arrays/array/th.txt b/hs-bindgen/fixtures/arrays/array/th.txt index 03abc0cc6..262c075bf 100644 --- a/hs-bindgen/fixtures/arrays/array/th.txt +++ b/hs-bindgen/fixtures/arrays/array/th.txt @@ -815,6 +815,22 @@ instance TyEq ty (CFieldType Sudoku "un_Sudoku") => instance HasCField Sudoku "un_Sudoku" where type CFieldType Sudoku "un_Sudoku" = ConstantArray 3 Triplet offset# = \_ -> \_ -> 0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a836491d63ff3a2c" fun_1_base :: BaseForeignType (CInt -> + Ptr CInt -> + IO CInt) +{-| Array of known size + +__C declaration:__ @fun_1@ + +__defined at:__ @arrays\/array.h:118:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_1@ +-} +fun_1 :: CInt -> Ptr CInt -> IO CInt {-| Array of known size __C declaration:__ @fun_1@ @@ -825,8 +841,11 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_1@ -} -foreign import ccall safe "hs_bindgen_a836491d63ff3a2c" fun_1 :: CInt -> - Ptr CInt -> IO CInt +fun_1 = fromBaseForeignType fun_1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c69f41e5ccc441ab" fun_2_base :: BaseForeignType (Ptr CInt -> + IO CInt) {-| Array of known size, typedef __C declaration:__ @fun_2@ @@ -837,8 +856,33 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_2@ -} -foreign import ccall safe "hs_bindgen_c69f41e5ccc441ab" fun_2 :: Ptr CInt -> - IO CInt +fun_2 :: Ptr CInt -> IO CInt +{-| Array of known size, typedef + +__C declaration:__ @fun_2@ + +__defined at:__ @arrays\/array.h:121:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_2@ +-} +fun_2 = fromBaseForeignType fun_2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_30065ddbffdd7502" fun_3_base :: BaseForeignType (Ptr CInt -> + IO CInt) +{-| Array of unknown size + +__C declaration:__ @fun_3@ + +__defined at:__ @arrays\/array.h:124:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_3@ +-} +fun_3 :: Ptr CInt -> IO CInt {-| Array of unknown size __C declaration:__ @fun_3@ @@ -849,8 +893,22 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_3@ -} -foreign import ccall safe "hs_bindgen_30065ddbffdd7502" fun_3 :: Ptr CInt -> - IO CInt +fun_3 = fromBaseForeignType fun_3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6e8db8abcb5fe22a" fun_4_base :: BaseForeignType (Ptr CInt -> + IO CInt) +{-| Array of unknown size, typedef + +__C declaration:__ @fun_4@ + +__defined at:__ @arrays\/array.h:127:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_4@ +-} +fun_4 :: Ptr CInt -> IO CInt {-| Array of unknown size, typedef __C declaration:__ @fun_4@ @@ -861,8 +919,12 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_4@ -} -foreign import ccall safe "hs_bindgen_6e8db8abcb5fe22a" fun_4 :: Ptr CInt -> - IO CInt +fun_4 = fromBaseForeignType fun_4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b2f48c31265a3f47" fun_5_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + IO CInt) {-| Multi-dimensional array of known size __C declaration:__ @fun_5@ @@ -873,9 +935,34 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_5@ -} -foreign import ccall safe "hs_bindgen_b2f48c31265a3f47" fun_5 :: Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_5 :: Ptr (ConstantArray 3 CInt) -> IO CInt +{-| Multi-dimensional array of known size + +__C declaration:__ @fun_5@ + +__defined at:__ @arrays\/array.h:130:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_5@ +-} +fun_5 = fromBaseForeignType fun_5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_343fe8ca0dbb7eb1" fun_6_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + IO CInt) +{-| Multi-dimensional array of known size, typedef + +__C declaration:__ @fun_6@ + +__defined at:__ @arrays\/array.h:133:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_6@ +-} +fun_6 :: Ptr (ConstantArray 3 CInt) -> IO CInt {-| Multi-dimensional array of known size, typedef __C declaration:__ @fun_6@ @@ -886,9 +973,12 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_6@ -} -foreign import ccall safe "hs_bindgen_343fe8ca0dbb7eb1" fun_6 :: Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_6 = fromBaseForeignType fun_6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d98a58d39b578fd6" fun_7_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + IO CInt) {-| Multi-dimensional array of unknown size __C declaration:__ @fun_7@ @@ -899,9 +989,23 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_7@ -} -foreign import ccall safe "hs_bindgen_d98a58d39b578fd6" fun_7 :: Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_7 :: Ptr (ConstantArray 3 CInt) -> IO CInt +{-| Multi-dimensional array of unknown size + +__C declaration:__ @fun_7@ + +__defined at:__ @arrays\/array.h:136:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_7@ +-} +fun_7 = fromBaseForeignType fun_7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4db12be6f46d98f5" fun_8_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + IO CInt) {-| Multi-dimensional array of unknown size, typedef __C declaration:__ @fun_8@ @@ -912,9 +1016,22 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_8@ -} -foreign import ccall safe "hs_bindgen_4db12be6f46d98f5" fun_8 :: Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_8 :: Ptr (ConstantArray 3 CInt) -> IO CInt +{-| Multi-dimensional array of unknown size, typedef + +__C declaration:__ @fun_8@ + +__defined at:__ @arrays\/array.h:139:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_8@ +-} +fun_8 = fromBaseForeignType fun_8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_825f9aeca071df21" isSolved_base :: BaseForeignType (Ptr Triplet -> + IO CInt) {-| Typedef-in-typedef __C declaration:__ @isSolved@ @@ -925,15 +1042,34 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_isSolved@ -} -foreign import ccall safe "hs_bindgen_825f9aeca071df21" isSolved :: Ptr Triplet -> - IO CInt +isSolved :: Ptr Triplet -> IO CInt +{-| Typedef-in-typedef + +__C declaration:__ @isSolved@ + +__defined at:__ @arrays\/array.h:142:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_isSolved@ +-} +isSolved = fromBaseForeignType isSolved_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a2bf6bc667c9e769" fun_1_const_wrapper_base :: BaseForeignType (CInt -> + Ptr CInt -> + Ptr CInt -> + IO CInt) +{-| Pointer-based API for 'fun_1_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_1_const@ +-} +fun_1_const_wrapper :: CInt -> Ptr CInt -> Ptr CInt -> IO CInt {-| Pointer-based API for 'fun_1_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_1_const@ -} -foreign import ccall safe "hs_bindgen_a2bf6bc667c9e769" fun_1_const_wrapper :: CInt -> - Ptr CInt -> - Ptr CInt -> IO CInt +fun_1_const_wrapper = fromBaseForeignType fun_1_const_wrapper_base {-| Array of known size __C declaration:__ @fun_1_const@ @@ -952,12 +1088,21 @@ __defined at:__ @arrays\/array.h:149:5@ __exported by:__ @arrays\/array.h@ -} fun_1_const = \x_0 -> \x_1 -> \x_2 -> withPtr x_2 (\ptr_3 -> fun_1_const_wrapper x_0 x_1 ptr_3) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ec5a6dd15a457a1d" fun_2_const_wrapper_base :: BaseForeignType (Ptr CInt -> + Ptr CInt -> + IO CInt) +{-| Pointer-based API for 'fun_2_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_2_const@ +-} +fun_2_const_wrapper :: Ptr CInt -> Ptr CInt -> IO CInt {-| Pointer-based API for 'fun_2_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_2_const@ -} -foreign import ccall safe "hs_bindgen_ec5a6dd15a457a1d" fun_2_const_wrapper :: Ptr CInt -> - Ptr CInt -> IO CInt +fun_2_const_wrapper = fromBaseForeignType fun_2_const_wrapper_base {-| Array of known size, typedef __C declaration:__ @fun_2_const@ @@ -976,12 +1121,21 @@ __defined at:__ @arrays\/array.h:152:5@ __exported by:__ @arrays\/array.h@ -} fun_2_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_2_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_84df1030280611db" fun_3_const_wrapper_base :: BaseForeignType (Ptr CInt -> + Ptr CInt -> + IO CInt) +{-| Pointer-based API for 'fun_3_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_3_const@ +-} +fun_3_const_wrapper :: Ptr CInt -> Ptr CInt -> IO CInt {-| Pointer-based API for 'fun_3_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_3_const@ -} -foreign import ccall safe "hs_bindgen_84df1030280611db" fun_3_const_wrapper :: Ptr CInt -> - Ptr CInt -> IO CInt +fun_3_const_wrapper = fromBaseForeignType fun_3_const_wrapper_base {-| Array of unknown size __C declaration:__ @fun_3_const@ @@ -1000,12 +1154,21 @@ __defined at:__ @arrays\/array.h:155:5@ __exported by:__ @arrays\/array.h@ -} fun_3_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_3_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e9dc927aa39d14d3" fun_4_const_wrapper_base :: BaseForeignType (Ptr CInt -> + Ptr CInt -> + IO CInt) +{-| Pointer-based API for 'fun_4_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_4_const@ +-} +fun_4_const_wrapper :: Ptr CInt -> Ptr CInt -> IO CInt {-| Pointer-based API for 'fun_4_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_4_const@ -} -foreign import ccall safe "hs_bindgen_e9dc927aa39d14d3" fun_4_const_wrapper :: Ptr CInt -> - Ptr CInt -> IO CInt +fun_4_const_wrapper = fromBaseForeignType fun_4_const_wrapper_base {-| Array of unknown size, typedef __C declaration:__ @fun_4_const@ @@ -1024,15 +1187,24 @@ __defined at:__ @arrays\/array.h:158:5@ __exported by:__ @arrays\/array.h@ -} fun_4_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_4_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cd0bfb26f385dfaa" fun_5_const_wrapper_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + Ptr (ConstantArray 3 + CInt) -> + IO CInt) +{-| Pointer-based API for 'fun_5_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_5_const@ +-} +fun_5_const_wrapper :: Ptr (ConstantArray 3 CInt) -> + Ptr (ConstantArray 3 CInt) -> IO CInt {-| Pointer-based API for 'fun_5_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_5_const@ -} -foreign import ccall safe "hs_bindgen_cd0bfb26f385dfaa" fun_5_const_wrapper :: Ptr (ConstantArray 3 - CInt) -> - Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_5_const_wrapper = fromBaseForeignType fun_5_const_wrapper_base {-| Multi-dimensional array of known size __C declaration:__ @fun_5_const@ @@ -1052,15 +1224,24 @@ __defined at:__ @arrays\/array.h:161:5@ __exported by:__ @arrays\/array.h@ -} fun_5_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_5_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1054ce6b48ed0f13" fun_6_const_wrapper_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + Ptr (ConstantArray 3 + CInt) -> + IO CInt) {-| Pointer-based API for 'fun_6_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_6_const@ -} -foreign import ccall safe "hs_bindgen_1054ce6b48ed0f13" fun_6_const_wrapper :: Ptr (ConstantArray 3 - CInt) -> - Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_6_const_wrapper :: Ptr (ConstantArray 3 CInt) -> + Ptr (ConstantArray 3 CInt) -> IO CInt +{-| Pointer-based API for 'fun_6_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_6_const@ +-} +fun_6_const_wrapper = fromBaseForeignType fun_6_const_wrapper_base {-| Multi-dimensional array of known size, typedef __C declaration:__ @fun_6_const@ @@ -1079,15 +1260,24 @@ __defined at:__ @arrays\/array.h:164:5@ __exported by:__ @arrays\/array.h@ -} fun_6_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_6_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_496902d7c6466098" fun_7_const_wrapper_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + Ptr (ConstantArray 3 + CInt) -> + IO CInt) {-| Pointer-based API for 'fun_7_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_7_const@ -} -foreign import ccall safe "hs_bindgen_496902d7c6466098" fun_7_const_wrapper :: Ptr (ConstantArray 3 - CInt) -> - Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_7_const_wrapper :: Ptr (ConstantArray 3 CInt) -> + Ptr (ConstantArray 3 CInt) -> IO CInt +{-| Pointer-based API for 'fun_7_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_7_const@ +-} +fun_7_const_wrapper = fromBaseForeignType fun_7_const_wrapper_base {-| Multi-dimensional array of unknown size __C declaration:__ @fun_7_const@ @@ -1107,15 +1297,24 @@ __defined at:__ @arrays\/array.h:167:5@ __exported by:__ @arrays\/array.h@ -} fun_7_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_7_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eb65cb5074167c48" fun_8_const_wrapper_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + Ptr (ConstantArray 3 + CInt) -> + IO CInt) {-| Pointer-based API for 'fun_8_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_8_const@ -} -foreign import ccall safe "hs_bindgen_eb65cb5074167c48" fun_8_const_wrapper :: Ptr (ConstantArray 3 - CInt) -> - Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_8_const_wrapper :: Ptr (ConstantArray 3 CInt) -> + Ptr (ConstantArray 3 CInt) -> IO CInt +{-| Pointer-based API for 'fun_8_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_8_const@ +-} +fun_8_const_wrapper = fromBaseForeignType fun_8_const_wrapper_base {-| Multi-dimensional array of unknown size, typedef __C declaration:__ @fun_8_const@ @@ -1134,13 +1333,21 @@ __defined at:__ @arrays\/array.h:170:5@ __exported by:__ @arrays\/array.h@ -} fun_8_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_8_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9bb064e9eddf07f7" isSolved_const_wrapper_base :: BaseForeignType (Ptr Triplet -> + Ptr Triplet -> + IO CInt) +{-| Pointer-based API for 'isSolved_const' + +__unique:__ @test_arraysarray_Example_Unsafe_isSolved_const@ +-} +isSolved_const_wrapper :: Ptr Triplet -> Ptr Triplet -> IO CInt {-| Pointer-based API for 'isSolved_const' __unique:__ @test_arraysarray_Example_Unsafe_isSolved_const@ -} -foreign import ccall safe "hs_bindgen_9bb064e9eddf07f7" isSolved_const_wrapper :: Ptr Triplet -> - Ptr Triplet -> - IO CInt +isSolved_const_wrapper = fromBaseForeignType isSolved_const_wrapper_base {-| Typedef-in-typedef __C declaration:__ @isSolved_const@ @@ -1159,6 +1366,21 @@ __defined at:__ @arrays\/array.h:173:5@ __exported by:__ @arrays\/array.h@ -} isSolved_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> isSolved_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0fa0a3e47fa9d95a" fun_9_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CInt))) +{-| Array of known size + +__C declaration:__ @fun_9@ + +__defined at:__ @arrays\/array.h:185:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_9@ +-} +fun_9 :: IO (Ptr (ConstantArray 3 CInt)) {-| Array of known size __C declaration:__ @fun_9@ @@ -1169,8 +1391,21 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_9@ -} -foreign import ccall safe "hs_bindgen_0fa0a3e47fa9d95a" fun_9 :: IO (Ptr (ConstantArray 3 - CInt)) +fun_9 = fromBaseForeignType fun_9_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e9d3d35727502125" fun_10_base :: BaseForeignType (IO (Ptr Triplet)) +{-| Array of known size, typedef + +__C declaration:__ @fun_10@ + +__defined at:__ @arrays\/array.h:188:10@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_10@ +-} +fun_10 :: IO (Ptr Triplet) {-| Array of known size, typedef __C declaration:__ @fun_10@ @@ -1181,7 +1416,21 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_10@ -} -foreign import ccall safe "hs_bindgen_e9d3d35727502125" fun_10 :: IO (Ptr Triplet) +fun_10 = fromBaseForeignType fun_10_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7f7cea54b33bf176" fun_11_base :: BaseForeignType (IO (Ptr (IncompleteArray CInt))) +{-| Array of unknown size + +__C declaration:__ @fun_11@ + +__defined at:__ @arrays\/array.h:191:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_11@ +-} +fun_11 :: IO (Ptr (IncompleteArray CInt)) {-| Array of unknown size __C declaration:__ @fun_11@ @@ -1192,7 +1441,10 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_11@ -} -foreign import ccall safe "hs_bindgen_7f7cea54b33bf176" fun_11 :: IO (Ptr (IncompleteArray CInt)) +fun_11 = fromBaseForeignType fun_11_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3124a96b00bbc082" fun_12_base :: BaseForeignType (IO (Ptr List)) {-| Array of unknown size, typedef __C declaration:__ @fun_12@ @@ -1203,7 +1455,23 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_12@ -} -foreign import ccall safe "hs_bindgen_3124a96b00bbc082" fun_12 :: IO (Ptr List) +fun_12 :: IO (Ptr List) +{-| Array of unknown size, typedef + +__C declaration:__ @fun_12@ + +__defined at:__ @arrays\/array.h:194:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_12@ +-} +fun_12 = fromBaseForeignType fun_12_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2fdd1bf9ee687f9b" fun_13_base :: BaseForeignType (IO (Ptr (ConstantArray 4 + (ConstantArray 3 + CInt)))) {-| Multi-dimensional array of known size __C declaration:__ @fun_13@ @@ -1214,9 +1482,32 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_13@ -} -foreign import ccall safe "hs_bindgen_2fdd1bf9ee687f9b" fun_13 :: IO (Ptr (ConstantArray 4 - (ConstantArray 3 - CInt))) +fun_13 :: IO (Ptr (ConstantArray 4 (ConstantArray 3 CInt))) +{-| Multi-dimensional array of known size + +__C declaration:__ @fun_13@ + +__defined at:__ @arrays\/array.h:197:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_13@ +-} +fun_13 = fromBaseForeignType fun_13_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_12a242894a3d45cb" fun_14_base :: BaseForeignType (IO (Ptr Matrix)) +{-| Multi-dimensional array of known size, typedef + +__C declaration:__ @fun_14@ + +__defined at:__ @arrays\/array.h:200:9@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_14@ +-} +fun_14 :: IO (Ptr Matrix) {-| Multi-dimensional array of known size, typedef __C declaration:__ @fun_14@ @@ -1227,7 +1518,11 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_14@ -} -foreign import ccall safe "hs_bindgen_12a242894a3d45cb" fun_14 :: IO (Ptr Matrix) +fun_14 = fromBaseForeignType fun_14_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d8e176eb5efefa2c" fun_15_base :: BaseForeignType (IO (Ptr (IncompleteArray (ConstantArray 3 + CInt)))) {-| Multi-dimensional array of unknown size __C declaration:__ @fun_15@ @@ -1238,8 +1533,21 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_15@ -} -foreign import ccall safe "hs_bindgen_d8e176eb5efefa2c" fun_15 :: IO (Ptr (IncompleteArray (ConstantArray 3 - CInt))) +fun_15 :: IO (Ptr (IncompleteArray (ConstantArray 3 CInt))) +{-| Multi-dimensional array of unknown size + +__C declaration:__ @fun_15@ + +__defined at:__ @arrays\/array.h:203:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_15@ +-} +fun_15 = fromBaseForeignType fun_15_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dcf234ca786626c7" fun_16_base :: BaseForeignType (IO (Ptr Tripletlist)) {-| Multi-dimensional array of unknown size, typedef __C declaration:__ @fun_16@ @@ -1250,7 +1558,32 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_16@ -} -foreign import ccall safe "hs_bindgen_dcf234ca786626c7" fun_16 :: IO (Ptr Tripletlist) +fun_16 :: IO (Ptr Tripletlist) +{-| Multi-dimensional array of unknown size, typedef + +__C declaration:__ @fun_16@ + +__defined at:__ @arrays\/array.h:206:14@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_16@ +-} +fun_16 = fromBaseForeignType fun_16_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f80a5b6a2770c658" solve_base :: BaseForeignType (IO (Ptr Sudoku)) +{-| Typedef-in-typedef + +__C declaration:__ @solve@ + +__defined at:__ @arrays\/array.h:209:10@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_solve@ +-} +solve :: IO (Ptr Sudoku) {-| Typedef-in-typedef __C declaration:__ @solve@ @@ -1261,7 +1594,23 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_solve@ -} -foreign import ccall safe "hs_bindgen_f80a5b6a2770c658" solve :: IO (Ptr Sudoku) +solve = fromBaseForeignType solve_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6d07a0b03f884547" fun_1_base :: BaseForeignType (CInt -> + Ptr CInt -> + IO CInt) +{-| Array of known size + +__C declaration:__ @fun_1@ + +__defined at:__ @arrays\/array.h:118:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_1@ +-} +fun_1 :: CInt -> Ptr CInt -> IO CInt {-| Array of known size __C declaration:__ @fun_1@ @@ -1272,8 +1621,11 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_1@ -} -foreign import ccall safe "hs_bindgen_6d07a0b03f884547" fun_1 :: CInt -> - Ptr CInt -> IO CInt +fun_1 = fromBaseForeignType fun_1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_04318f98a3ab8d08" fun_2_base :: BaseForeignType (Ptr CInt -> + IO CInt) {-| Array of known size, typedef __C declaration:__ @fun_2@ @@ -1284,8 +1636,22 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_2@ -} -foreign import ccall safe "hs_bindgen_04318f98a3ab8d08" fun_2 :: Ptr CInt -> - IO CInt +fun_2 :: Ptr CInt -> IO CInt +{-| Array of known size, typedef + +__C declaration:__ @fun_2@ + +__defined at:__ @arrays\/array.h:121:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_2@ +-} +fun_2 = fromBaseForeignType fun_2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2a7c5fa1040fa8db" fun_3_base :: BaseForeignType (Ptr CInt -> + IO CInt) {-| Array of unknown size __C declaration:__ @fun_3@ @@ -1296,8 +1662,33 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_3@ -} -foreign import ccall safe "hs_bindgen_2a7c5fa1040fa8db" fun_3 :: Ptr CInt -> - IO CInt +fun_3 :: Ptr CInt -> IO CInt +{-| Array of unknown size + +__C declaration:__ @fun_3@ + +__defined at:__ @arrays\/array.h:124:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_3@ +-} +fun_3 = fromBaseForeignType fun_3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_810acc5cf8729d0e" fun_4_base :: BaseForeignType (Ptr CInt -> + IO CInt) +{-| Array of unknown size, typedef + +__C declaration:__ @fun_4@ + +__defined at:__ @arrays\/array.h:127:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_4@ +-} +fun_4 :: Ptr CInt -> IO CInt {-| Array of unknown size, typedef __C declaration:__ @fun_4@ @@ -1308,8 +1699,23 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_4@ -} -foreign import ccall safe "hs_bindgen_810acc5cf8729d0e" fun_4 :: Ptr CInt -> - IO CInt +fun_4 = fromBaseForeignType fun_4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_83b71f7defb3b27a" fun_5_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + IO CInt) +{-| Multi-dimensional array of known size + +__C declaration:__ @fun_5@ + +__defined at:__ @arrays\/array.h:130:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_5@ +-} +fun_5 :: Ptr (ConstantArray 3 CInt) -> IO CInt {-| Multi-dimensional array of known size __C declaration:__ @fun_5@ @@ -1320,9 +1726,12 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_5@ -} -foreign import ccall safe "hs_bindgen_83b71f7defb3b27a" fun_5 :: Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_5 = fromBaseForeignType fun_5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_62b76af3dc65da3f" fun_6_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + IO CInt) {-| Multi-dimensional array of known size, typedef __C declaration:__ @fun_6@ @@ -1333,9 +1742,23 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_6@ -} -foreign import ccall safe "hs_bindgen_62b76af3dc65da3f" fun_6 :: Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_6 :: Ptr (ConstantArray 3 CInt) -> IO CInt +{-| Multi-dimensional array of known size, typedef + +__C declaration:__ @fun_6@ + +__defined at:__ @arrays\/array.h:133:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_6@ +-} +fun_6 = fromBaseForeignType fun_6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_100aa7fb87a5ea74" fun_7_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + IO CInt) {-| Multi-dimensional array of unknown size __C declaration:__ @fun_7@ @@ -1346,9 +1769,34 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_7@ -} -foreign import ccall safe "hs_bindgen_100aa7fb87a5ea74" fun_7 :: Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_7 :: Ptr (ConstantArray 3 CInt) -> IO CInt +{-| Multi-dimensional array of unknown size + +__C declaration:__ @fun_7@ + +__defined at:__ @arrays\/array.h:136:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_7@ +-} +fun_7 = fromBaseForeignType fun_7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cd6646babeacd609" fun_8_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + IO CInt) +{-| Multi-dimensional array of unknown size, typedef + +__C declaration:__ @fun_8@ + +__defined at:__ @arrays\/array.h:139:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_8@ +-} +fun_8 :: Ptr (ConstantArray 3 CInt) -> IO CInt {-| Multi-dimensional array of unknown size, typedef __C declaration:__ @fun_8@ @@ -1359,9 +1807,22 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_8@ -} -foreign import ccall safe "hs_bindgen_cd6646babeacd609" fun_8 :: Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_8 = fromBaseForeignType fun_8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_560f1de9a83c3a6a" isSolved_base :: BaseForeignType (Ptr Triplet -> + IO CInt) +{-| Typedef-in-typedef + +__C declaration:__ @isSolved@ + +__defined at:__ @arrays\/array.h:142:5@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_isSolved@ +-} +isSolved :: Ptr Triplet -> IO CInt {-| Typedef-in-typedef __C declaration:__ @isSolved@ @@ -1372,15 +1833,23 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_isSolved@ -} -foreign import ccall safe "hs_bindgen_560f1de9a83c3a6a" isSolved :: Ptr Triplet -> - IO CInt +isSolved = fromBaseForeignType isSolved_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ef3b85ae74bc06cf" fun_1_const_wrapper_base :: BaseForeignType (CInt -> + Ptr CInt -> + Ptr CInt -> + IO CInt) +{-| Pointer-based API for 'fun_1_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_1_const@ +-} +fun_1_const_wrapper :: CInt -> Ptr CInt -> Ptr CInt -> IO CInt {-| Pointer-based API for 'fun_1_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_1_const@ -} -foreign import ccall safe "hs_bindgen_ef3b85ae74bc06cf" fun_1_const_wrapper :: CInt -> - Ptr CInt -> - Ptr CInt -> IO CInt +fun_1_const_wrapper = fromBaseForeignType fun_1_const_wrapper_base {-| Array of known size __C declaration:__ @fun_1_const@ @@ -1399,12 +1868,21 @@ __defined at:__ @arrays\/array.h:149:5@ __exported by:__ @arrays\/array.h@ -} fun_1_const = \x_0 -> \x_1 -> \x_2 -> withPtr x_2 (\ptr_3 -> fun_1_const_wrapper x_0 x_1 ptr_3) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1c913685e5e76952" fun_2_const_wrapper_base :: BaseForeignType (Ptr CInt -> + Ptr CInt -> + IO CInt) {-| Pointer-based API for 'fun_2_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_2_const@ -} -foreign import ccall safe "hs_bindgen_1c913685e5e76952" fun_2_const_wrapper :: Ptr CInt -> - Ptr CInt -> IO CInt +fun_2_const_wrapper :: Ptr CInt -> Ptr CInt -> IO CInt +{-| Pointer-based API for 'fun_2_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_2_const@ +-} +fun_2_const_wrapper = fromBaseForeignType fun_2_const_wrapper_base {-| Array of known size, typedef __C declaration:__ @fun_2_const@ @@ -1423,12 +1901,21 @@ __defined at:__ @arrays\/array.h:152:5@ __exported by:__ @arrays\/array.h@ -} fun_2_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_2_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eb8daf22bd5c6f00" fun_3_const_wrapper_base :: BaseForeignType (Ptr CInt -> + Ptr CInt -> + IO CInt) {-| Pointer-based API for 'fun_3_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_3_const@ -} -foreign import ccall safe "hs_bindgen_eb8daf22bd5c6f00" fun_3_const_wrapper :: Ptr CInt -> - Ptr CInt -> IO CInt +fun_3_const_wrapper :: Ptr CInt -> Ptr CInt -> IO CInt +{-| Pointer-based API for 'fun_3_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_3_const@ +-} +fun_3_const_wrapper = fromBaseForeignType fun_3_const_wrapper_base {-| Array of unknown size __C declaration:__ @fun_3_const@ @@ -1447,12 +1934,21 @@ __defined at:__ @arrays\/array.h:155:5@ __exported by:__ @arrays\/array.h@ -} fun_3_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_3_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0b73e4c7695a3b2f" fun_4_const_wrapper_base :: BaseForeignType (Ptr CInt -> + Ptr CInt -> + IO CInt) +{-| Pointer-based API for 'fun_4_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_4_const@ +-} +fun_4_const_wrapper :: Ptr CInt -> Ptr CInt -> IO CInt {-| Pointer-based API for 'fun_4_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_4_const@ -} -foreign import ccall safe "hs_bindgen_0b73e4c7695a3b2f" fun_4_const_wrapper :: Ptr CInt -> - Ptr CInt -> IO CInt +fun_4_const_wrapper = fromBaseForeignType fun_4_const_wrapper_base {-| Array of unknown size, typedef __C declaration:__ @fun_4_const@ @@ -1471,15 +1967,24 @@ __defined at:__ @arrays\/array.h:158:5@ __exported by:__ @arrays\/array.h@ -} fun_4_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_4_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_374feb8086895fe3" fun_5_const_wrapper_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + Ptr (ConstantArray 3 + CInt) -> + IO CInt) {-| Pointer-based API for 'fun_5_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_5_const@ -} -foreign import ccall safe "hs_bindgen_374feb8086895fe3" fun_5_const_wrapper :: Ptr (ConstantArray 3 - CInt) -> - Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_5_const_wrapper :: Ptr (ConstantArray 3 CInt) -> + Ptr (ConstantArray 3 CInt) -> IO CInt +{-| Pointer-based API for 'fun_5_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_5_const@ +-} +fun_5_const_wrapper = fromBaseForeignType fun_5_const_wrapper_base {-| Multi-dimensional array of known size __C declaration:__ @fun_5_const@ @@ -1499,15 +2004,24 @@ __defined at:__ @arrays\/array.h:161:5@ __exported by:__ @arrays\/array.h@ -} fun_5_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_5_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2d1320b468c36708" fun_6_const_wrapper_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + Ptr (ConstantArray 3 + CInt) -> + IO CInt) +{-| Pointer-based API for 'fun_6_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_6_const@ +-} +fun_6_const_wrapper :: Ptr (ConstantArray 3 CInt) -> + Ptr (ConstantArray 3 CInt) -> IO CInt {-| Pointer-based API for 'fun_6_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_6_const@ -} -foreign import ccall safe "hs_bindgen_2d1320b468c36708" fun_6_const_wrapper :: Ptr (ConstantArray 3 - CInt) -> - Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_6_const_wrapper = fromBaseForeignType fun_6_const_wrapper_base {-| Multi-dimensional array of known size, typedef __C declaration:__ @fun_6_const@ @@ -1525,16 +2039,25 @@ __defined at:__ @arrays\/array.h:164:5@ __exported by:__ @arrays\/array.h@ -} -fun_6_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_6_const_wrapper x_0 ptr_2) +fun_6_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_6_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f67f5fe5bfb57aa1" fun_7_const_wrapper_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + Ptr (ConstantArray 3 + CInt) -> + IO CInt) +{-| Pointer-based API for 'fun_7_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_7_const@ +-} +fun_7_const_wrapper :: Ptr (ConstantArray 3 CInt) -> + Ptr (ConstantArray 3 CInt) -> IO CInt {-| Pointer-based API for 'fun_7_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_7_const@ -} -foreign import ccall safe "hs_bindgen_f67f5fe5bfb57aa1" fun_7_const_wrapper :: Ptr (ConstantArray 3 - CInt) -> - Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_7_const_wrapper = fromBaseForeignType fun_7_const_wrapper_base {-| Multi-dimensional array of unknown size __C declaration:__ @fun_7_const@ @@ -1554,15 +2077,24 @@ __defined at:__ @arrays\/array.h:167:5@ __exported by:__ @arrays\/array.h@ -} fun_7_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_7_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2c9356851d76320e" fun_8_const_wrapper_base :: BaseForeignType (Ptr (ConstantArray 3 + CInt) -> + Ptr (ConstantArray 3 + CInt) -> + IO CInt) +{-| Pointer-based API for 'fun_8_const' + +__unique:__ @test_arraysarray_Example_Unsafe_fun_8_const@ +-} +fun_8_const_wrapper :: Ptr (ConstantArray 3 CInt) -> + Ptr (ConstantArray 3 CInt) -> IO CInt {-| Pointer-based API for 'fun_8_const' __unique:__ @test_arraysarray_Example_Unsafe_fun_8_const@ -} -foreign import ccall safe "hs_bindgen_2c9356851d76320e" fun_8_const_wrapper :: Ptr (ConstantArray 3 - CInt) -> - Ptr (ConstantArray 3 - CInt) -> - IO CInt +fun_8_const_wrapper = fromBaseForeignType fun_8_const_wrapper_base {-| Multi-dimensional array of unknown size, typedef __C declaration:__ @fun_8_const@ @@ -1581,13 +2113,21 @@ __defined at:__ @arrays\/array.h:170:5@ __exported by:__ @arrays\/array.h@ -} fun_8_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> fun_8_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_39b08b64fed0c5b8" isSolved_const_wrapper_base :: BaseForeignType (Ptr Triplet -> + Ptr Triplet -> + IO CInt) {-| Pointer-based API for 'isSolved_const' __unique:__ @test_arraysarray_Example_Unsafe_isSolved_const@ -} -foreign import ccall safe "hs_bindgen_39b08b64fed0c5b8" isSolved_const_wrapper :: Ptr Triplet -> - Ptr Triplet -> - IO CInt +isSolved_const_wrapper :: Ptr Triplet -> Ptr Triplet -> IO CInt +{-| Pointer-based API for 'isSolved_const' + +__unique:__ @test_arraysarray_Example_Unsafe_isSolved_const@ +-} +isSolved_const_wrapper = fromBaseForeignType isSolved_const_wrapper_base {-| Typedef-in-typedef __C declaration:__ @isSolved_const@ @@ -1606,6 +2146,21 @@ __defined at:__ @arrays\/array.h:173:5@ __exported by:__ @arrays\/array.h@ -} isSolved_const = \x_0 -> \x_1 -> withPtr x_1 (\ptr_2 -> isSolved_const_wrapper x_0 ptr_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ab431ebc0519545a" fun_9_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CInt))) +{-| Array of known size + +__C declaration:__ @fun_9@ + +__defined at:__ @arrays\/array.h:185:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_9@ +-} +fun_9 :: IO (Ptr (ConstantArray 3 CInt)) {-| Array of known size __C declaration:__ @fun_9@ @@ -1616,8 +2171,21 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_9@ -} -foreign import ccall safe "hs_bindgen_ab431ebc0519545a" fun_9 :: IO (Ptr (ConstantArray 3 - CInt)) +fun_9 = fromBaseForeignType fun_9_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c9ff623e6f48d3bc" fun_10_base :: BaseForeignType (IO (Ptr Triplet)) +{-| Array of known size, typedef + +__C declaration:__ @fun_10@ + +__defined at:__ @arrays\/array.h:188:10@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_10@ +-} +fun_10 :: IO (Ptr Triplet) {-| Array of known size, typedef __C declaration:__ @fun_10@ @@ -1628,7 +2196,21 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_10@ -} -foreign import ccall safe "hs_bindgen_c9ff623e6f48d3bc" fun_10 :: IO (Ptr Triplet) +fun_10 = fromBaseForeignType fun_10_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e714f0b7c764ba17" fun_11_base :: BaseForeignType (IO (Ptr (IncompleteArray CInt))) +{-| Array of unknown size + +__C declaration:__ @fun_11@ + +__defined at:__ @arrays\/array.h:191:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_11@ +-} +fun_11 :: IO (Ptr (IncompleteArray CInt)) {-| Array of unknown size __C declaration:__ @fun_11@ @@ -1639,7 +2221,21 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_11@ -} -foreign import ccall safe "hs_bindgen_e714f0b7c764ba17" fun_11 :: IO (Ptr (IncompleteArray CInt)) +fun_11 = fromBaseForeignType fun_11_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cc23741700ba18f7" fun_12_base :: BaseForeignType (IO (Ptr List)) +{-| Array of unknown size, typedef + +__C declaration:__ @fun_12@ + +__defined at:__ @arrays\/array.h:194:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_12@ +-} +fun_12 :: IO (Ptr List) {-| Array of unknown size, typedef __C declaration:__ @fun_12@ @@ -1650,7 +2246,23 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_12@ -} -foreign import ccall safe "hs_bindgen_cc23741700ba18f7" fun_12 :: IO (Ptr List) +fun_12 = fromBaseForeignType fun_12_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eb3a1364003829ac" fun_13_base :: BaseForeignType (IO (Ptr (ConstantArray 4 + (ConstantArray 3 + CInt)))) +{-| Multi-dimensional array of known size + +__C declaration:__ @fun_13@ + +__defined at:__ @arrays\/array.h:197:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_13@ +-} +fun_13 :: IO (Ptr (ConstantArray 4 (ConstantArray 3 CInt))) {-| Multi-dimensional array of known size __C declaration:__ @fun_13@ @@ -1661,9 +2273,21 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_13@ -} -foreign import ccall safe "hs_bindgen_eb3a1364003829ac" fun_13 :: IO (Ptr (ConstantArray 4 - (ConstantArray 3 - CInt))) +fun_13 = fromBaseForeignType fun_13_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0f49ffbe2c13ab46" fun_14_base :: BaseForeignType (IO (Ptr Matrix)) +{-| Multi-dimensional array of known size, typedef + +__C declaration:__ @fun_14@ + +__defined at:__ @arrays\/array.h:200:9@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_14@ +-} +fun_14 :: IO (Ptr Matrix) {-| Multi-dimensional array of known size, typedef __C declaration:__ @fun_14@ @@ -1674,7 +2298,22 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_14@ -} -foreign import ccall safe "hs_bindgen_0f49ffbe2c13ab46" fun_14 :: IO (Ptr Matrix) +fun_14 = fromBaseForeignType fun_14_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_59de769fbba4ed72" fun_15_base :: BaseForeignType (IO (Ptr (IncompleteArray (ConstantArray 3 + CInt)))) +{-| Multi-dimensional array of unknown size + +__C declaration:__ @fun_15@ + +__defined at:__ @arrays\/array.h:203:7@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_15@ +-} +fun_15 :: IO (Ptr (IncompleteArray (ConstantArray 3 CInt))) {-| Multi-dimensional array of unknown size __C declaration:__ @fun_15@ @@ -1685,8 +2324,21 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_15@ -} -foreign import ccall safe "hs_bindgen_59de769fbba4ed72" fun_15 :: IO (Ptr (IncompleteArray (ConstantArray 3 - CInt))) +fun_15 = fromBaseForeignType fun_15_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1d6ecccfa4ee16ff" fun_16_base :: BaseForeignType (IO (Ptr Tripletlist)) +{-| Multi-dimensional array of unknown size, typedef + +__C declaration:__ @fun_16@ + +__defined at:__ @arrays\/array.h:206:14@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_fun_16@ +-} +fun_16 :: IO (Ptr Tripletlist) {-| Multi-dimensional array of unknown size, typedef __C declaration:__ @fun_16@ @@ -1697,7 +2349,21 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_fun_16@ -} -foreign import ccall safe "hs_bindgen_1d6ecccfa4ee16ff" fun_16 :: IO (Ptr Tripletlist) +fun_16 = fromBaseForeignType fun_16_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6165085eab7d2806" solve_base :: BaseForeignType (IO (Ptr Sudoku)) +{-| Typedef-in-typedef + +__C declaration:__ @solve@ + +__defined at:__ @arrays\/array.h:209:10@ + +__exported by:__ @arrays\/array.h@ + +__unique:__ @test_arraysarray_Example_Unsafe_solve@ +-} +solve :: IO (Ptr Sudoku) {-| Typedef-in-typedef __C declaration:__ @solve@ @@ -1708,13 +2374,20 @@ __exported by:__ @arrays\/array.h@ __unique:__ @test_arraysarray_Example_Unsafe_solve@ -} -foreign import ccall safe "hs_bindgen_6165085eab7d2806" solve :: IO (Ptr Sudoku) +solve = fromBaseForeignType solve_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3da43df5677c71ad" hs_bindgen_3da43df5677c71ad_base :: BaseForeignType (IO (FunPtr (CInt -> + ConstantArray 3 + CInt -> + IO CInt))) {-| __unique:__ @test_arraysarray_Example_get_fun_1_ptr@ -} -foreign import ccall safe "hs_bindgen_3da43df5677c71ad" hs_bindgen_3da43df5677c71ad :: IO (FunPtr (CInt -> - ConstantArray 3 - CInt -> - IO CInt)) +hs_bindgen_3da43df5677c71ad :: IO (FunPtr (CInt -> + ConstantArray 3 CInt -> IO CInt)) +{-| __unique:__ @test_arraysarray_Example_get_fun_1_ptr@ +-} +hs_bindgen_3da43df5677c71ad = fromBaseForeignType hs_bindgen_3da43df5677c71ad_base {-# NOINLINE fun_1_ptr #-} {-| Array of known size @@ -1734,10 +2407,16 @@ __defined at:__ @arrays\/array.h:118:5@ __exported by:__ @arrays\/array.h@ -} fun_1_ptr = unsafePerformIO hs_bindgen_3da43df5677c71ad +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2170297251bf6d62" hs_bindgen_2170297251bf6d62_base :: BaseForeignType (IO (FunPtr (Triplet -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_2_ptr@ +-} +hs_bindgen_2170297251bf6d62 :: IO (FunPtr (Triplet -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_2_ptr@ -} -foreign import ccall safe "hs_bindgen_2170297251bf6d62" hs_bindgen_2170297251bf6d62 :: IO (FunPtr (Triplet -> - IO CInt)) +hs_bindgen_2170297251bf6d62 = fromBaseForeignType hs_bindgen_2170297251bf6d62_base {-# NOINLINE fun_2_ptr #-} {-| Array of known size, typedef @@ -1757,10 +2436,17 @@ __defined at:__ @arrays\/array.h:121:5@ __exported by:__ @arrays\/array.h@ -} fun_2_ptr = unsafePerformIO hs_bindgen_2170297251bf6d62 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a90e84da83866d0e" hs_bindgen_a90e84da83866d0e_base :: BaseForeignType (IO (FunPtr (IncompleteArray CInt -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_3_ptr@ +-} +hs_bindgen_a90e84da83866d0e :: IO (FunPtr (IncompleteArray CInt -> + IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_3_ptr@ -} -foreign import ccall safe "hs_bindgen_a90e84da83866d0e" hs_bindgen_a90e84da83866d0e :: IO (FunPtr (IncompleteArray CInt -> - IO CInt)) +hs_bindgen_a90e84da83866d0e = fromBaseForeignType hs_bindgen_a90e84da83866d0e_base {-# NOINLINE fun_3_ptr #-} {-| Array of unknown size @@ -1780,10 +2466,16 @@ __defined at:__ @arrays\/array.h:124:5@ __exported by:__ @arrays\/array.h@ -} fun_3_ptr = unsafePerformIO hs_bindgen_a90e84da83866d0e +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_93e48e07f9f40577" hs_bindgen_93e48e07f9f40577_base :: BaseForeignType (IO (FunPtr (List -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_4_ptr@ +-} +hs_bindgen_93e48e07f9f40577 :: IO (FunPtr (List -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_4_ptr@ -} -foreign import ccall safe "hs_bindgen_93e48e07f9f40577" hs_bindgen_93e48e07f9f40577 :: IO (FunPtr (List -> - IO CInt)) +hs_bindgen_93e48e07f9f40577 = fromBaseForeignType hs_bindgen_93e48e07f9f40577_base {-# NOINLINE fun_4_ptr #-} {-| Array of unknown size, typedef @@ -1803,12 +2495,20 @@ __defined at:__ @arrays\/array.h:127:5@ __exported by:__ @arrays\/array.h@ -} fun_4_ptr = unsafePerformIO hs_bindgen_93e48e07f9f40577 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3fadc044f8437855" hs_bindgen_3fadc044f8437855_base :: BaseForeignType (IO (FunPtr (ConstantArray 4 + (ConstantArray 3 + CInt) -> + IO CInt))) {-| __unique:__ @test_arraysarray_Example_get_fun_5_ptr@ -} -foreign import ccall safe "hs_bindgen_3fadc044f8437855" hs_bindgen_3fadc044f8437855 :: IO (FunPtr (ConstantArray 4 - (ConstantArray 3 - CInt) -> - IO CInt)) +hs_bindgen_3fadc044f8437855 :: IO (FunPtr (ConstantArray 4 + (ConstantArray 3 CInt) -> + IO CInt)) +{-| __unique:__ @test_arraysarray_Example_get_fun_5_ptr@ +-} +hs_bindgen_3fadc044f8437855 = fromBaseForeignType hs_bindgen_3fadc044f8437855_base {-# NOINLINE fun_5_ptr #-} {-| Multi-dimensional array of known size @@ -1829,10 +2529,16 @@ __defined at:__ @arrays\/array.h:130:5@ __exported by:__ @arrays\/array.h@ -} fun_5_ptr = unsafePerformIO hs_bindgen_3fadc044f8437855 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4b116cc6e48e6c3b" hs_bindgen_4b116cc6e48e6c3b_base :: BaseForeignType (IO (FunPtr (Matrix -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_6_ptr@ +-} +hs_bindgen_4b116cc6e48e6c3b :: IO (FunPtr (Matrix -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_6_ptr@ -} -foreign import ccall safe "hs_bindgen_4b116cc6e48e6c3b" hs_bindgen_4b116cc6e48e6c3b :: IO (FunPtr (Matrix -> - IO CInt)) +hs_bindgen_4b116cc6e48e6c3b = fromBaseForeignType hs_bindgen_4b116cc6e48e6c3b_base {-# NOINLINE fun_6_ptr #-} {-| Multi-dimensional array of known size, typedef @@ -1852,11 +2558,19 @@ __defined at:__ @arrays\/array.h:133:5@ __exported by:__ @arrays\/array.h@ -} fun_6_ptr = unsafePerformIO hs_bindgen_4b116cc6e48e6c3b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_27f76815dbc61f73" hs_bindgen_27f76815dbc61f73_base :: BaseForeignType (IO (FunPtr (IncompleteArray (ConstantArray 3 + CInt) -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_7_ptr@ +-} +hs_bindgen_27f76815dbc61f73 :: IO (FunPtr (IncompleteArray (ConstantArray 3 + CInt) -> + IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_7_ptr@ -} -foreign import ccall safe "hs_bindgen_27f76815dbc61f73" hs_bindgen_27f76815dbc61f73 :: IO (FunPtr (IncompleteArray (ConstantArray 3 - CInt) -> - IO CInt)) +hs_bindgen_27f76815dbc61f73 = fromBaseForeignType hs_bindgen_27f76815dbc61f73_base {-# NOINLINE fun_7_ptr #-} {-| Multi-dimensional array of unknown size @@ -1877,10 +2591,16 @@ __defined at:__ @arrays\/array.h:136:5@ __exported by:__ @arrays\/array.h@ -} fun_7_ptr = unsafePerformIO hs_bindgen_27f76815dbc61f73 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a79b67b394d1dab8" hs_bindgen_a79b67b394d1dab8_base :: BaseForeignType (IO (FunPtr (Tripletlist -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_8_ptr@ +-} +hs_bindgen_a79b67b394d1dab8 :: IO (FunPtr (Tripletlist -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_8_ptr@ -} -foreign import ccall safe "hs_bindgen_a79b67b394d1dab8" hs_bindgen_a79b67b394d1dab8 :: IO (FunPtr (Tripletlist -> - IO CInt)) +hs_bindgen_a79b67b394d1dab8 = fromBaseForeignType hs_bindgen_a79b67b394d1dab8_base {-# NOINLINE fun_8_ptr #-} {-| Multi-dimensional array of unknown size, typedef @@ -1900,10 +2620,16 @@ __defined at:__ @arrays\/array.h:139:5@ __exported by:__ @arrays\/array.h@ -} fun_8_ptr = unsafePerformIO hs_bindgen_a79b67b394d1dab8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3035f04158da4ea8" hs_bindgen_3035f04158da4ea8_base :: BaseForeignType (IO (FunPtr (Sudoku -> + IO CInt))) {-| __unique:__ @test_arraysarray_Example_get_isSolved_ptr@ -} -foreign import ccall safe "hs_bindgen_3035f04158da4ea8" hs_bindgen_3035f04158da4ea8 :: IO (FunPtr (Sudoku -> - IO CInt)) +hs_bindgen_3035f04158da4ea8 :: IO (FunPtr (Sudoku -> IO CInt)) +{-| __unique:__ @test_arraysarray_Example_get_isSolved_ptr@ +-} +hs_bindgen_3035f04158da4ea8 = fromBaseForeignType hs_bindgen_3035f04158da4ea8_base {-# NOINLINE isSolved_ptr #-} {-| Typedef-in-typedef @@ -1923,14 +2649,21 @@ __defined at:__ @arrays\/array.h:142:5@ __exported by:__ @arrays\/array.h@ -} isSolved_ptr = unsafePerformIO hs_bindgen_3035f04158da4ea8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4ca938a03ef0961a" hs_bindgen_4ca938a03ef0961a_base :: BaseForeignType (IO (FunPtr (CInt -> + ConstantArray 3 + CInt -> + ConstantArray 3 + CInt -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_1_const_ptr@ +-} +hs_bindgen_4ca938a03ef0961a :: IO (FunPtr (CInt -> + ConstantArray 3 CInt -> ConstantArray 3 CInt -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_1_const_ptr@ -} -foreign import ccall safe "hs_bindgen_4ca938a03ef0961a" hs_bindgen_4ca938a03ef0961a :: IO (FunPtr (CInt -> - ConstantArray 3 - CInt -> - ConstantArray 3 - CInt -> - IO CInt)) +hs_bindgen_4ca938a03ef0961a = fromBaseForeignType hs_bindgen_4ca938a03ef0961a_base {-# NOINLINE fun_1_const_ptr #-} {-| Array of known size @@ -1951,11 +2684,18 @@ __defined at:__ @arrays\/array.h:149:5@ __exported by:__ @arrays\/array.h@ -} fun_1_const_ptr = unsafePerformIO hs_bindgen_4ca938a03ef0961a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ab436eab87e0d868" hs_bindgen_ab436eab87e0d868_base :: BaseForeignType (IO (FunPtr (Triplet -> + Triplet -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_2_const_ptr@ +-} +hs_bindgen_ab436eab87e0d868 :: IO (FunPtr (Triplet -> + Triplet -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_2_const_ptr@ -} -foreign import ccall safe "hs_bindgen_ab436eab87e0d868" hs_bindgen_ab436eab87e0d868 :: IO (FunPtr (Triplet -> - Triplet -> - IO CInt)) +hs_bindgen_ab436eab87e0d868 = fromBaseForeignType hs_bindgen_ab436eab87e0d868_base {-# NOINLINE fun_2_const_ptr #-} {-| Array of known size, typedef @@ -1975,11 +2715,18 @@ __defined at:__ @arrays\/array.h:152:5@ __exported by:__ @arrays\/array.h@ -} fun_2_const_ptr = unsafePerformIO hs_bindgen_ab436eab87e0d868 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_98d06bd5403ada68" hs_bindgen_98d06bd5403ada68_base :: BaseForeignType (IO (FunPtr (IncompleteArray CInt -> + IncompleteArray CInt -> + IO CInt))) {-| __unique:__ @test_arraysarray_Example_get_fun_3_const_ptr@ -} -foreign import ccall safe "hs_bindgen_98d06bd5403ada68" hs_bindgen_98d06bd5403ada68 :: IO (FunPtr (IncompleteArray CInt -> - IncompleteArray CInt -> - IO CInt)) +hs_bindgen_98d06bd5403ada68 :: IO (FunPtr (IncompleteArray CInt -> + IncompleteArray CInt -> IO CInt)) +{-| __unique:__ @test_arraysarray_Example_get_fun_3_const_ptr@ +-} +hs_bindgen_98d06bd5403ada68 = fromBaseForeignType hs_bindgen_98d06bd5403ada68_base {-# NOINLINE fun_3_const_ptr #-} {-| Array of unknown size @@ -2000,11 +2747,18 @@ __defined at:__ @arrays\/array.h:155:5@ __exported by:__ @arrays\/array.h@ -} fun_3_const_ptr = unsafePerformIO hs_bindgen_98d06bd5403ada68 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_73a3249ecd4b2587" hs_bindgen_73a3249ecd4b2587_base :: BaseForeignType (IO (FunPtr (List -> + List -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_4_const_ptr@ +-} +hs_bindgen_73a3249ecd4b2587 :: IO (FunPtr (List -> + List -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_4_const_ptr@ -} -foreign import ccall safe "hs_bindgen_73a3249ecd4b2587" hs_bindgen_73a3249ecd4b2587 :: IO (FunPtr (List -> - List -> - IO CInt)) +hs_bindgen_73a3249ecd4b2587 = fromBaseForeignType hs_bindgen_73a3249ecd4b2587_base {-# NOINLINE fun_4_const_ptr #-} {-| Array of unknown size, typedef @@ -2024,15 +2778,23 @@ __defined at:__ @arrays\/array.h:158:5@ __exported by:__ @arrays\/array.h@ -} fun_4_const_ptr = unsafePerformIO hs_bindgen_73a3249ecd4b2587 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7a4270e16880a707" hs_bindgen_7a4270e16880a707_base :: BaseForeignType (IO (FunPtr (ConstantArray 4 + (ConstantArray 3 + CInt) -> + ConstantArray 4 + (ConstantArray 3 + CInt) -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_5_const_ptr@ +-} +hs_bindgen_7a4270e16880a707 :: IO (FunPtr (ConstantArray 4 + (ConstantArray 3 CInt) -> + ConstantArray 4 (ConstantArray 3 CInt) -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_5_const_ptr@ -} -foreign import ccall safe "hs_bindgen_7a4270e16880a707" hs_bindgen_7a4270e16880a707 :: IO (FunPtr (ConstantArray 4 - (ConstantArray 3 - CInt) -> - ConstantArray 4 - (ConstantArray 3 - CInt) -> - IO CInt)) +hs_bindgen_7a4270e16880a707 = fromBaseForeignType hs_bindgen_7a4270e16880a707_base {-# NOINLINE fun_5_const_ptr #-} {-| Multi-dimensional array of known size @@ -2054,11 +2816,18 @@ __defined at:__ @arrays\/array.h:161:5@ __exported by:__ @arrays\/array.h@ -} fun_5_const_ptr = unsafePerformIO hs_bindgen_7a4270e16880a707 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7d046eec920d0789" hs_bindgen_7d046eec920d0789_base :: BaseForeignType (IO (FunPtr (Matrix -> + Matrix -> + IO CInt))) {-| __unique:__ @test_arraysarray_Example_get_fun_6_const_ptr@ -} -foreign import ccall safe "hs_bindgen_7d046eec920d0789" hs_bindgen_7d046eec920d0789 :: IO (FunPtr (Matrix -> - Matrix -> - IO CInt)) +hs_bindgen_7d046eec920d0789 :: IO (FunPtr (Matrix -> + Matrix -> IO CInt)) +{-| __unique:__ @test_arraysarray_Example_get_fun_6_const_ptr@ +-} +hs_bindgen_7d046eec920d0789 = fromBaseForeignType hs_bindgen_7d046eec920d0789_base {-# NOINLINE fun_6_const_ptr #-} {-| Multi-dimensional array of known size, typedef @@ -2078,13 +2847,21 @@ __defined at:__ @arrays\/array.h:164:5@ __exported by:__ @arrays\/array.h@ -} fun_6_const_ptr = unsafePerformIO hs_bindgen_7d046eec920d0789 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e60c9fdf601f4d52" hs_bindgen_e60c9fdf601f4d52_base :: BaseForeignType (IO (FunPtr (IncompleteArray (ConstantArray 3 + CInt) -> + IncompleteArray (ConstantArray 3 + CInt) -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_7_const_ptr@ +-} +hs_bindgen_e60c9fdf601f4d52 :: IO (FunPtr (IncompleteArray (ConstantArray 3 + CInt) -> + IncompleteArray (ConstantArray 3 CInt) -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_7_const_ptr@ -} -foreign import ccall safe "hs_bindgen_e60c9fdf601f4d52" hs_bindgen_e60c9fdf601f4d52 :: IO (FunPtr (IncompleteArray (ConstantArray 3 - CInt) -> - IncompleteArray (ConstantArray 3 - CInt) -> - IO CInt)) +hs_bindgen_e60c9fdf601f4d52 = fromBaseForeignType hs_bindgen_e60c9fdf601f4d52_base {-# NOINLINE fun_7_const_ptr #-} {-| Multi-dimensional array of unknown size @@ -2106,11 +2883,18 @@ __defined at:__ @arrays\/array.h:167:5@ __exported by:__ @arrays\/array.h@ -} fun_7_const_ptr = unsafePerformIO hs_bindgen_e60c9fdf601f4d52 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_26377cb588f993f2" hs_bindgen_26377cb588f993f2_base :: BaseForeignType (IO (FunPtr (Tripletlist -> + Tripletlist -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_fun_8_const_ptr@ +-} +hs_bindgen_26377cb588f993f2 :: IO (FunPtr (Tripletlist -> + Tripletlist -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_fun_8_const_ptr@ -} -foreign import ccall safe "hs_bindgen_26377cb588f993f2" hs_bindgen_26377cb588f993f2 :: IO (FunPtr (Tripletlist -> - Tripletlist -> - IO CInt)) +hs_bindgen_26377cb588f993f2 = fromBaseForeignType hs_bindgen_26377cb588f993f2_base {-# NOINLINE fun_8_const_ptr #-} {-| Multi-dimensional array of unknown size, typedef @@ -2130,11 +2914,18 @@ __defined at:__ @arrays\/array.h:170:5@ __exported by:__ @arrays\/array.h@ -} fun_8_const_ptr = unsafePerformIO hs_bindgen_26377cb588f993f2 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_525c462baff9c281" hs_bindgen_525c462baff9c281_base :: BaseForeignType (IO (FunPtr (Sudoku -> + Sudoku -> + IO CInt))) +{-| __unique:__ @test_arraysarray_Example_get_isSolved_const_ptr@ +-} +hs_bindgen_525c462baff9c281 :: IO (FunPtr (Sudoku -> + Sudoku -> IO CInt)) {-| __unique:__ @test_arraysarray_Example_get_isSolved_const_ptr@ -} -foreign import ccall safe "hs_bindgen_525c462baff9c281" hs_bindgen_525c462baff9c281 :: IO (FunPtr (Sudoku -> - Sudoku -> - IO CInt)) +hs_bindgen_525c462baff9c281 = fromBaseForeignType hs_bindgen_525c462baff9c281_base {-# NOINLINE isSolved_const_ptr #-} {-| Typedef-in-typedef @@ -2154,10 +2945,17 @@ __defined at:__ @arrays\/array.h:173:5@ __exported by:__ @arrays\/array.h@ -} isSolved_const_ptr = unsafePerformIO hs_bindgen_525c462baff9c281 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1ee64a8054febdc1" hs_bindgen_1ee64a8054febdc1_base :: BaseForeignType (IO (FunPtr (IO (Ptr (ConstantArray 3 + CInt))))) {-| __unique:__ @test_arraysarray_Example_get_fun_9_ptr@ -} -foreign import ccall safe "hs_bindgen_1ee64a8054febdc1" hs_bindgen_1ee64a8054febdc1 :: IO (FunPtr (IO (Ptr (ConstantArray 3 - CInt)))) +hs_bindgen_1ee64a8054febdc1 :: IO (FunPtr (IO (Ptr (ConstantArray 3 + CInt)))) +{-| __unique:__ @test_arraysarray_Example_get_fun_9_ptr@ +-} +hs_bindgen_1ee64a8054febdc1 = fromBaseForeignType hs_bindgen_1ee64a8054febdc1_base {-# NOINLINE fun_9_ptr #-} {-| Array of known size @@ -2177,9 +2975,15 @@ __defined at:__ @arrays\/array.h:185:7@ __exported by:__ @arrays\/array.h@ -} fun_9_ptr = unsafePerformIO hs_bindgen_1ee64a8054febdc1 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c8090d6b86a88ba0" hs_bindgen_c8090d6b86a88ba0_base :: BaseForeignType (IO (FunPtr (IO (Ptr Triplet)))) +{-| __unique:__ @test_arraysarray_Example_get_fun_10_ptr@ +-} +hs_bindgen_c8090d6b86a88ba0 :: IO (FunPtr (IO (Ptr Triplet))) {-| __unique:__ @test_arraysarray_Example_get_fun_10_ptr@ -} -foreign import ccall safe "hs_bindgen_c8090d6b86a88ba0" hs_bindgen_c8090d6b86a88ba0 :: IO (FunPtr (IO (Ptr Triplet))) +hs_bindgen_c8090d6b86a88ba0 = fromBaseForeignType hs_bindgen_c8090d6b86a88ba0_base {-# NOINLINE fun_10_ptr #-} {-| Array of known size, typedef @@ -2199,9 +3003,15 @@ __defined at:__ @arrays\/array.h:188:10@ __exported by:__ @arrays\/array.h@ -} fun_10_ptr = unsafePerformIO hs_bindgen_c8090d6b86a88ba0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4f90fd6464df2b20" hs_bindgen_4f90fd6464df2b20_base :: BaseForeignType (IO (FunPtr (IO (Ptr (IncompleteArray CInt))))) +{-| __unique:__ @test_arraysarray_Example_get_fun_11_ptr@ +-} +hs_bindgen_4f90fd6464df2b20 :: IO (FunPtr (IO (Ptr (IncompleteArray CInt)))) {-| __unique:__ @test_arraysarray_Example_get_fun_11_ptr@ -} -foreign import ccall safe "hs_bindgen_4f90fd6464df2b20" hs_bindgen_4f90fd6464df2b20 :: IO (FunPtr (IO (Ptr (IncompleteArray CInt)))) +hs_bindgen_4f90fd6464df2b20 = fromBaseForeignType hs_bindgen_4f90fd6464df2b20_base {-# NOINLINE fun_11_ptr #-} {-| Array of unknown size @@ -2221,9 +3031,15 @@ __defined at:__ @arrays\/array.h:191:7@ __exported by:__ @arrays\/array.h@ -} fun_11_ptr = unsafePerformIO hs_bindgen_4f90fd6464df2b20 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4b4a73f20be545eb" hs_bindgen_4b4a73f20be545eb_base :: BaseForeignType (IO (FunPtr (IO (Ptr List)))) +{-| __unique:__ @test_arraysarray_Example_get_fun_12_ptr@ +-} +hs_bindgen_4b4a73f20be545eb :: IO (FunPtr (IO (Ptr List))) {-| __unique:__ @test_arraysarray_Example_get_fun_12_ptr@ -} -foreign import ccall safe "hs_bindgen_4b4a73f20be545eb" hs_bindgen_4b4a73f20be545eb :: IO (FunPtr (IO (Ptr List))) +hs_bindgen_4b4a73f20be545eb = fromBaseForeignType hs_bindgen_4b4a73f20be545eb_base {-# NOINLINE fun_12_ptr #-} {-| Array of unknown size, typedef @@ -2243,11 +3059,18 @@ __defined at:__ @arrays\/array.h:194:7@ __exported by:__ @arrays\/array.h@ -} fun_12_ptr = unsafePerformIO hs_bindgen_4b4a73f20be545eb +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a88be261251caf90" hs_bindgen_a88be261251caf90_base :: BaseForeignType (IO (FunPtr (IO (Ptr (ConstantArray 4 + (ConstantArray 3 + CInt)))))) {-| __unique:__ @test_arraysarray_Example_get_fun_13_ptr@ -} -foreign import ccall safe "hs_bindgen_a88be261251caf90" hs_bindgen_a88be261251caf90 :: IO (FunPtr (IO (Ptr (ConstantArray 4 - (ConstantArray 3 - CInt))))) +hs_bindgen_a88be261251caf90 :: IO (FunPtr (IO (Ptr (ConstantArray 4 + (ConstantArray 3 CInt))))) +{-| __unique:__ @test_arraysarray_Example_get_fun_13_ptr@ +-} +hs_bindgen_a88be261251caf90 = fromBaseForeignType hs_bindgen_a88be261251caf90_base {-# NOINLINE fun_13_ptr #-} {-| Multi-dimensional array of known size @@ -2268,9 +3091,15 @@ __defined at:__ @arrays\/array.h:197:7@ __exported by:__ @arrays\/array.h@ -} fun_13_ptr = unsafePerformIO hs_bindgen_a88be261251caf90 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2f0a2188338306d9" hs_bindgen_2f0a2188338306d9_base :: BaseForeignType (IO (FunPtr (IO (Ptr Matrix)))) +{-| __unique:__ @test_arraysarray_Example_get_fun_14_ptr@ +-} +hs_bindgen_2f0a2188338306d9 :: IO (FunPtr (IO (Ptr Matrix))) {-| __unique:__ @test_arraysarray_Example_get_fun_14_ptr@ -} -foreign import ccall safe "hs_bindgen_2f0a2188338306d9" hs_bindgen_2f0a2188338306d9 :: IO (FunPtr (IO (Ptr Matrix))) +hs_bindgen_2f0a2188338306d9 = fromBaseForeignType hs_bindgen_2f0a2188338306d9_base {-# NOINLINE fun_14_ptr #-} {-| Multi-dimensional array of known size, typedef @@ -2290,10 +3119,17 @@ __defined at:__ @arrays\/array.h:200:9@ __exported by:__ @arrays\/array.h@ -} fun_14_ptr = unsafePerformIO hs_bindgen_2f0a2188338306d9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_30af82288a309775" hs_bindgen_30af82288a309775_base :: BaseForeignType (IO (FunPtr (IO (Ptr (IncompleteArray (ConstantArray 3 + CInt)))))) +{-| __unique:__ @test_arraysarray_Example_get_fun_15_ptr@ +-} +hs_bindgen_30af82288a309775 :: IO (FunPtr (IO (Ptr (IncompleteArray (ConstantArray 3 + CInt))))) {-| __unique:__ @test_arraysarray_Example_get_fun_15_ptr@ -} -foreign import ccall safe "hs_bindgen_30af82288a309775" hs_bindgen_30af82288a309775 :: IO (FunPtr (IO (Ptr (IncompleteArray (ConstantArray 3 - CInt))))) +hs_bindgen_30af82288a309775 = fromBaseForeignType hs_bindgen_30af82288a309775_base {-# NOINLINE fun_15_ptr #-} {-| Multi-dimensional array of unknown size @@ -2314,9 +3150,15 @@ __defined at:__ @arrays\/array.h:203:7@ __exported by:__ @arrays\/array.h@ -} fun_15_ptr = unsafePerformIO hs_bindgen_30af82288a309775 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fb63d18d5d1004fb" hs_bindgen_fb63d18d5d1004fb_base :: BaseForeignType (IO (FunPtr (IO (Ptr Tripletlist)))) +{-| __unique:__ @test_arraysarray_Example_get_fun_16_ptr@ +-} +hs_bindgen_fb63d18d5d1004fb :: IO (FunPtr (IO (Ptr Tripletlist))) {-| __unique:__ @test_arraysarray_Example_get_fun_16_ptr@ -} -foreign import ccall safe "hs_bindgen_fb63d18d5d1004fb" hs_bindgen_fb63d18d5d1004fb :: IO (FunPtr (IO (Ptr Tripletlist))) +hs_bindgen_fb63d18d5d1004fb = fromBaseForeignType hs_bindgen_fb63d18d5d1004fb_base {-# NOINLINE fun_16_ptr #-} {-| Multi-dimensional array of unknown size, typedef @@ -2336,9 +3178,15 @@ __defined at:__ @arrays\/array.h:206:14@ __exported by:__ @arrays\/array.h@ -} fun_16_ptr = unsafePerformIO hs_bindgen_fb63d18d5d1004fb +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e7d751562a2e3c6c" hs_bindgen_e7d751562a2e3c6c_base :: BaseForeignType (IO (FunPtr (IO (Ptr Sudoku)))) {-| __unique:__ @test_arraysarray_Example_get_solve_ptr@ -} -foreign import ccall safe "hs_bindgen_e7d751562a2e3c6c" hs_bindgen_e7d751562a2e3c6c :: IO (FunPtr (IO (Ptr Sudoku))) +hs_bindgen_e7d751562a2e3c6c :: IO (FunPtr (IO (Ptr Sudoku))) +{-| __unique:__ @test_arraysarray_Example_get_solve_ptr@ +-} +hs_bindgen_e7d751562a2e3c6c = fromBaseForeignType hs_bindgen_e7d751562a2e3c6c_base {-# NOINLINE solve_ptr #-} {-| Typedef-in-typedef @@ -2358,10 +3206,16 @@ __defined at:__ @arrays\/array.h:209:10@ __exported by:__ @arrays\/array.h@ -} solve_ptr = unsafePerformIO hs_bindgen_e7d751562a2e3c6c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dd2a346b95b769db" hs_bindgen_dd2a346b95b769db_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CInt))) +{-| __unique:__ @test_arraysarray_Example_get_arr0_ptr@ +-} +hs_bindgen_dd2a346b95b769db :: IO (Ptr (ConstantArray 3 CInt)) {-| __unique:__ @test_arraysarray_Example_get_arr0_ptr@ -} -foreign import ccall safe "hs_bindgen_dd2a346b95b769db" hs_bindgen_dd2a346b95b769db :: IO (Ptr (ConstantArray 3 - CInt)) +hs_bindgen_dd2a346b95b769db = fromBaseForeignType hs_bindgen_dd2a346b95b769db_base {-# NOINLINE arr0_ptr #-} {-| Global, complete, not initialised @@ -2381,10 +3235,16 @@ __defined at:__ @arrays\/array.h:11:5@ __exported by:__ @arrays\/array.h@ -} arr0_ptr = unsafePerformIO hs_bindgen_dd2a346b95b769db +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3867a46f740e141f" hs_bindgen_3867a46f740e141f_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CInt))) +{-| __unique:__ @test_arraysarray_Example_get_arr1_ptr@ +-} +hs_bindgen_3867a46f740e141f :: IO (Ptr (ConstantArray 3 CInt)) {-| __unique:__ @test_arraysarray_Example_get_arr1_ptr@ -} -foreign import ccall safe "hs_bindgen_3867a46f740e141f" hs_bindgen_3867a46f740e141f :: IO (Ptr (ConstantArray 3 - CInt)) +hs_bindgen_3867a46f740e141f = fromBaseForeignType hs_bindgen_3867a46f740e141f_base {-# NOINLINE arr1_ptr #-} {-| Global, complete, initialised @@ -2404,10 +3264,16 @@ __defined at:__ @arrays\/array.h:14:5@ __exported by:__ @arrays\/array.h@ -} arr1_ptr = unsafePerformIO hs_bindgen_3867a46f740e141f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c1b5868da3cfebbe" hs_bindgen_c1b5868da3cfebbe_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CInt))) +{-| __unique:__ @test_arraysarray_Example_get_arr2_ptr@ +-} +hs_bindgen_c1b5868da3cfebbe :: IO (Ptr (ConstantArray 3 CInt)) {-| __unique:__ @test_arraysarray_Example_get_arr2_ptr@ -} -foreign import ccall safe "hs_bindgen_c1b5868da3cfebbe" hs_bindgen_c1b5868da3cfebbe :: IO (Ptr (ConstantArray 3 - CInt)) +hs_bindgen_c1b5868da3cfebbe = fromBaseForeignType hs_bindgen_c1b5868da3cfebbe_base {-# NOINLINE arr2_ptr #-} {-| Global, extern, complete, not initialised @@ -2427,10 +3293,16 @@ __defined at:__ @arrays\/array.h:17:12@ __exported by:__ @arrays\/array.h@ -} arr2_ptr = unsafePerformIO hs_bindgen_c1b5868da3cfebbe +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_697b55cf10c5c7ae" hs_bindgen_697b55cf10c5c7ae_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CInt))) {-| __unique:__ @test_arraysarray_Example_get_arr3_ptr@ -} -foreign import ccall safe "hs_bindgen_697b55cf10c5c7ae" hs_bindgen_697b55cf10c5c7ae :: IO (Ptr (ConstantArray 3 - CInt)) +hs_bindgen_697b55cf10c5c7ae :: IO (Ptr (ConstantArray 3 CInt)) +{-| __unique:__ @test_arraysarray_Example_get_arr3_ptr@ +-} +hs_bindgen_697b55cf10c5c7ae = fromBaseForeignType hs_bindgen_697b55cf10c5c7ae_base {-# NOINLINE arr3_ptr #-} {-| Global, extern, complete, initialised @@ -2450,10 +3322,16 @@ __defined at:__ @arrays\/array.h:20:12@ __exported by:__ @arrays\/array.h@ -} arr3_ptr = unsafePerformIO hs_bindgen_697b55cf10c5c7ae +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f935cbe0a13b4987" hs_bindgen_f935cbe0a13b4987_base :: BaseForeignType (IO (Ptr (ConstantArray 1 + CInt))) +{-| __unique:__ @test_arraysarray_Example_get_arr6_ptr@ +-} +hs_bindgen_f935cbe0a13b4987 :: IO (Ptr (ConstantArray 1 CInt)) {-| __unique:__ @test_arraysarray_Example_get_arr6_ptr@ -} -foreign import ccall safe "hs_bindgen_f935cbe0a13b4987" hs_bindgen_f935cbe0a13b4987 :: IO (Ptr (ConstantArray 1 - CInt)) +hs_bindgen_f935cbe0a13b4987 = fromBaseForeignType hs_bindgen_f935cbe0a13b4987_base {-# NOINLINE arr6_ptr #-} {-| Global, incomplete @@ -2473,9 +3351,15 @@ __defined at:__ @arrays\/array.h:29:5@ __exported by:__ @arrays\/array.h@ -} arr6_ptr = unsafePerformIO hs_bindgen_f935cbe0a13b4987 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_673085071176d81a" hs_bindgen_673085071176d81a_base :: BaseForeignType (IO (Ptr (IncompleteArray CInt))) +{-| __unique:__ @test_arraysarray_Example_get_arr7_ptr@ +-} +hs_bindgen_673085071176d81a :: IO (Ptr (IncompleteArray CInt)) {-| __unique:__ @test_arraysarray_Example_get_arr7_ptr@ -} -foreign import ccall safe "hs_bindgen_673085071176d81a" hs_bindgen_673085071176d81a :: IO (Ptr (IncompleteArray CInt)) +hs_bindgen_673085071176d81a = fromBaseForeignType hs_bindgen_673085071176d81a_base {-# NOINLINE arr7_ptr #-} {-| Global, extern, incomplete @@ -2495,10 +3379,16 @@ __defined at:__ @arrays\/array.h:32:12@ __exported by:__ @arrays\/array.h@ -} arr7_ptr = unsafePerformIO hs_bindgen_673085071176d81a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3cf195887769eb3d" hs_bindgen_3cf195887769eb3d_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CInt))) +{-| __unique:__ @test_arraysarray_Example_get_arr_1_ptr@ +-} +hs_bindgen_3cf195887769eb3d :: IO (Ptr (ConstantArray 3 CInt)) {-| __unique:__ @test_arraysarray_Example_get_arr_1_ptr@ -} -foreign import ccall safe "hs_bindgen_3cf195887769eb3d" hs_bindgen_3cf195887769eb3d :: IO (Ptr (ConstantArray 3 - CInt)) +hs_bindgen_3cf195887769eb3d = fromBaseForeignType hs_bindgen_3cf195887769eb3d_base {-# NOINLINE arr_1_ptr #-} {-| Array of known size @@ -2518,9 +3408,15 @@ __defined at:__ @arrays\/array.h:62:12@ __exported by:__ @arrays\/array.h@ -} arr_1_ptr = unsafePerformIO hs_bindgen_3cf195887769eb3d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4621cb499a2b4cd3" hs_bindgen_4621cb499a2b4cd3_base :: BaseForeignType (IO (Ptr Triplet)) {-| __unique:__ @test_arraysarray_Example_get_arr_2_ptr@ -} -foreign import ccall safe "hs_bindgen_4621cb499a2b4cd3" hs_bindgen_4621cb499a2b4cd3 :: IO (Ptr Triplet) +hs_bindgen_4621cb499a2b4cd3 :: IO (Ptr Triplet) +{-| __unique:__ @test_arraysarray_Example_get_arr_2_ptr@ +-} +hs_bindgen_4621cb499a2b4cd3 = fromBaseForeignType hs_bindgen_4621cb499a2b4cd3_base {-# NOINLINE arr_2_ptr #-} {-| Array of known size, typedef @@ -2540,9 +3436,15 @@ __defined at:__ @arrays\/array.h:65:16@ __exported by:__ @arrays\/array.h@ -} arr_2_ptr = unsafePerformIO hs_bindgen_4621cb499a2b4cd3 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cb7148df8f0668ef" hs_bindgen_cb7148df8f0668ef_base :: BaseForeignType (IO (Ptr (IncompleteArray CInt))) +{-| __unique:__ @test_arraysarray_Example_get_arr_3_ptr@ +-} +hs_bindgen_cb7148df8f0668ef :: IO (Ptr (IncompleteArray CInt)) {-| __unique:__ @test_arraysarray_Example_get_arr_3_ptr@ -} -foreign import ccall safe "hs_bindgen_cb7148df8f0668ef" hs_bindgen_cb7148df8f0668ef :: IO (Ptr (IncompleteArray CInt)) +hs_bindgen_cb7148df8f0668ef = fromBaseForeignType hs_bindgen_cb7148df8f0668ef_base {-# NOINLINE arr_3_ptr #-} {-| Array of unknown size @@ -2562,9 +3464,15 @@ __defined at:__ @arrays\/array.h:68:12@ __exported by:__ @arrays\/array.h@ -} arr_3_ptr = unsafePerformIO hs_bindgen_cb7148df8f0668ef +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f0a4984c74b89803" hs_bindgen_f0a4984c74b89803_base :: BaseForeignType (IO (Ptr List)) +{-| __unique:__ @test_arraysarray_Example_get_arr_4_ptr@ +-} +hs_bindgen_f0a4984c74b89803 :: IO (Ptr List) {-| __unique:__ @test_arraysarray_Example_get_arr_4_ptr@ -} -foreign import ccall safe "hs_bindgen_f0a4984c74b89803" hs_bindgen_f0a4984c74b89803 :: IO (Ptr List) +hs_bindgen_f0a4984c74b89803 = fromBaseForeignType hs_bindgen_f0a4984c74b89803_base {-# NOINLINE arr_4_ptr #-} {-| Array of unknown size, typedef @@ -2584,11 +3492,18 @@ __defined at:__ @arrays\/array.h:71:13@ __exported by:__ @arrays\/array.h@ -} arr_4_ptr = unsafePerformIO hs_bindgen_f0a4984c74b89803 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9f555ad1567e295a" hs_bindgen_9f555ad1567e295a_base :: BaseForeignType (IO (Ptr (ConstantArray 4 + (ConstantArray 3 + CInt)))) +{-| __unique:__ @test_arraysarray_Example_get_arr_5_ptr@ +-} +hs_bindgen_9f555ad1567e295a :: IO (Ptr (ConstantArray 4 + (ConstantArray 3 CInt))) {-| __unique:__ @test_arraysarray_Example_get_arr_5_ptr@ -} -foreign import ccall safe "hs_bindgen_9f555ad1567e295a" hs_bindgen_9f555ad1567e295a :: IO (Ptr (ConstantArray 4 - (ConstantArray 3 - CInt))) +hs_bindgen_9f555ad1567e295a = fromBaseForeignType hs_bindgen_9f555ad1567e295a_base {-# NOINLINE arr_5_ptr #-} {-| Multi-dimensional array of known size @@ -2608,9 +3523,15 @@ __defined at:__ @arrays\/array.h:74:12@ __exported by:__ @arrays\/array.h@ -} arr_5_ptr = unsafePerformIO hs_bindgen_9f555ad1567e295a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f016939597566966" hs_bindgen_f016939597566966_base :: BaseForeignType (IO (Ptr Matrix)) {-| __unique:__ @test_arraysarray_Example_get_arr_6_ptr@ -} -foreign import ccall safe "hs_bindgen_f016939597566966" hs_bindgen_f016939597566966 :: IO (Ptr Matrix) +hs_bindgen_f016939597566966 :: IO (Ptr Matrix) +{-| __unique:__ @test_arraysarray_Example_get_arr_6_ptr@ +-} +hs_bindgen_f016939597566966 = fromBaseForeignType hs_bindgen_f016939597566966_base {-# NOINLINE arr_6_ptr #-} {-| Multi-dimensional array of known size, typedef @@ -2630,10 +3551,17 @@ __defined at:__ @arrays\/array.h:77:15@ __exported by:__ @arrays\/array.h@ -} arr_6_ptr = unsafePerformIO hs_bindgen_f016939597566966 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bb1876e9c2ece223" hs_bindgen_bb1876e9c2ece223_base :: BaseForeignType (IO (Ptr (IncompleteArray (ConstantArray 3 + CInt)))) +{-| __unique:__ @test_arraysarray_Example_get_arr_7_ptr@ +-} +hs_bindgen_bb1876e9c2ece223 :: IO (Ptr (IncompleteArray (ConstantArray 3 + CInt))) {-| __unique:__ @test_arraysarray_Example_get_arr_7_ptr@ -} -foreign import ccall safe "hs_bindgen_bb1876e9c2ece223" hs_bindgen_bb1876e9c2ece223 :: IO (Ptr (IncompleteArray (ConstantArray 3 - CInt))) +hs_bindgen_bb1876e9c2ece223 = fromBaseForeignType hs_bindgen_bb1876e9c2ece223_base {-# NOINLINE arr_7_ptr #-} {-| Multi-dimensional array of unknown size @@ -2653,9 +3581,15 @@ __defined at:__ @arrays\/array.h:80:12@ __exported by:__ @arrays\/array.h@ -} arr_7_ptr = unsafePerformIO hs_bindgen_bb1876e9c2ece223 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dc2a31e3f871adec" hs_bindgen_dc2a31e3f871adec_base :: BaseForeignType (IO (Ptr Tripletlist)) +{-| __unique:__ @test_arraysarray_Example_get_arr_8_ptr@ +-} +hs_bindgen_dc2a31e3f871adec :: IO (Ptr Tripletlist) {-| __unique:__ @test_arraysarray_Example_get_arr_8_ptr@ -} -foreign import ccall safe "hs_bindgen_dc2a31e3f871adec" hs_bindgen_dc2a31e3f871adec :: IO (Ptr Tripletlist) +hs_bindgen_dc2a31e3f871adec = fromBaseForeignType hs_bindgen_dc2a31e3f871adec_base {-# NOINLINE arr_8_ptr #-} {-| Multi-dimensional array of unknown size, typedef @@ -2675,10 +3609,16 @@ __defined at:__ @arrays\/array.h:83:20@ __exported by:__ @arrays\/array.h@ -} arr_8_ptr = unsafePerformIO hs_bindgen_dc2a31e3f871adec +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fc9438d00f745eee" hs_bindgen_fc9438d00f745eee_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CInt))) +{-| __unique:__ @test_arraysarray_Example_get_arr_1_const_ptr@ +-} +hs_bindgen_fc9438d00f745eee :: IO (Ptr (ConstantArray 3 CInt)) {-| __unique:__ @test_arraysarray_Example_get_arr_1_const_ptr@ -} -foreign import ccall safe "hs_bindgen_fc9438d00f745eee" hs_bindgen_fc9438d00f745eee :: IO (Ptr (ConstantArray 3 - CInt)) +hs_bindgen_fc9438d00f745eee = fromBaseForeignType hs_bindgen_fc9438d00f745eee_base {-# NOINLINE arr_1_const_ptr #-} {-| Array of known size @@ -2701,9 +3641,15 @@ arr_1_const_ptr = unsafePerformIO hs_bindgen_fc9438d00f745eee {-# NOINLINE arr_1_const #-} arr_1_const :: ConstantArray 3 CInt arr_1_const = unsafePerformIO (peek arr_1_const_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_be3eba6be1a73c5d" hs_bindgen_be3eba6be1a73c5d_base :: BaseForeignType (IO (Ptr Triplet)) {-| __unique:__ @test_arraysarray_Example_get_arr_2_const_ptr@ -} -foreign import ccall safe "hs_bindgen_be3eba6be1a73c5d" hs_bindgen_be3eba6be1a73c5d :: IO (Ptr Triplet) +hs_bindgen_be3eba6be1a73c5d :: IO (Ptr Triplet) +{-| __unique:__ @test_arraysarray_Example_get_arr_2_const_ptr@ +-} +hs_bindgen_be3eba6be1a73c5d = fromBaseForeignType hs_bindgen_be3eba6be1a73c5d_base {-# NOINLINE arr_2_const_ptr #-} {-| Array of known size, typedef @@ -2726,9 +3672,15 @@ arr_2_const_ptr = unsafePerformIO hs_bindgen_be3eba6be1a73c5d {-# NOINLINE arr_2_const #-} arr_2_const :: Triplet arr_2_const = unsafePerformIO (peek arr_2_const_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0c3c415a6bdd56a6" hs_bindgen_0c3c415a6bdd56a6_base :: BaseForeignType (IO (Ptr (IncompleteArray CInt))) +{-| __unique:__ @test_arraysarray_Example_get_arr_3_const_ptr@ +-} +hs_bindgen_0c3c415a6bdd56a6 :: IO (Ptr (IncompleteArray CInt)) {-| __unique:__ @test_arraysarray_Example_get_arr_3_const_ptr@ -} -foreign import ccall safe "hs_bindgen_0c3c415a6bdd56a6" hs_bindgen_0c3c415a6bdd56a6 :: IO (Ptr (IncompleteArray CInt)) +hs_bindgen_0c3c415a6bdd56a6 = fromBaseForeignType hs_bindgen_0c3c415a6bdd56a6_base {-# NOINLINE arr_3_const_ptr #-} {-| Array of unknown size @@ -2748,9 +3700,15 @@ __defined at:__ @arrays\/array.h:96:18@ __exported by:__ @arrays\/array.h@ -} arr_3_const_ptr = unsafePerformIO hs_bindgen_0c3c415a6bdd56a6 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a6fa7483b9d48043" hs_bindgen_a6fa7483b9d48043_base :: BaseForeignType (IO (Ptr List)) +{-| __unique:__ @test_arraysarray_Example_get_arr_4_const_ptr@ +-} +hs_bindgen_a6fa7483b9d48043 :: IO (Ptr List) {-| __unique:__ @test_arraysarray_Example_get_arr_4_const_ptr@ -} -foreign import ccall safe "hs_bindgen_a6fa7483b9d48043" hs_bindgen_a6fa7483b9d48043 :: IO (Ptr List) +hs_bindgen_a6fa7483b9d48043 = fromBaseForeignType hs_bindgen_a6fa7483b9d48043_base {-# NOINLINE arr_4_const_ptr #-} {-| Array of unknown size, typedef @@ -2770,11 +3728,18 @@ __defined at:__ @arrays\/array.h:99:19@ __exported by:__ @arrays\/array.h@ -} arr_4_const_ptr = unsafePerformIO hs_bindgen_a6fa7483b9d48043 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_93b436ac5ffd8c82" hs_bindgen_93b436ac5ffd8c82_base :: BaseForeignType (IO (Ptr (ConstantArray 4 + (ConstantArray 3 + CInt)))) +{-| __unique:__ @test_arraysarray_Example_get_arr_5_const_ptr@ +-} +hs_bindgen_93b436ac5ffd8c82 :: IO (Ptr (ConstantArray 4 + (ConstantArray 3 CInt))) {-| __unique:__ @test_arraysarray_Example_get_arr_5_const_ptr@ -} -foreign import ccall safe "hs_bindgen_93b436ac5ffd8c82" hs_bindgen_93b436ac5ffd8c82 :: IO (Ptr (ConstantArray 4 - (ConstantArray 3 - CInt))) +hs_bindgen_93b436ac5ffd8c82 = fromBaseForeignType hs_bindgen_93b436ac5ffd8c82_base {-# NOINLINE arr_5_const_ptr #-} {-| Multi-dimensional array of known size @@ -2797,9 +3762,15 @@ arr_5_const_ptr = unsafePerformIO hs_bindgen_93b436ac5ffd8c82 {-# NOINLINE arr_5_const #-} arr_5_const :: ConstantArray 4 (ConstantArray 3 CInt) arr_5_const = unsafePerformIO (peek arr_5_const_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9e625256c9dc1a3f" hs_bindgen_9e625256c9dc1a3f_base :: BaseForeignType (IO (Ptr Matrix)) {-| __unique:__ @test_arraysarray_Example_get_arr_6_const_ptr@ -} -foreign import ccall safe "hs_bindgen_9e625256c9dc1a3f" hs_bindgen_9e625256c9dc1a3f :: IO (Ptr Matrix) +hs_bindgen_9e625256c9dc1a3f :: IO (Ptr Matrix) +{-| __unique:__ @test_arraysarray_Example_get_arr_6_const_ptr@ +-} +hs_bindgen_9e625256c9dc1a3f = fromBaseForeignType hs_bindgen_9e625256c9dc1a3f_base {-# NOINLINE arr_6_const_ptr #-} {-| Multi-dimensional array of known size, typedef @@ -2822,10 +3793,17 @@ arr_6_const_ptr = unsafePerformIO hs_bindgen_9e625256c9dc1a3f {-# NOINLINE arr_6_const #-} arr_6_const :: Matrix arr_6_const = unsafePerformIO (peek arr_6_const_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_19cc3c6537ef51f0" hs_bindgen_19cc3c6537ef51f0_base :: BaseForeignType (IO (Ptr (IncompleteArray (ConstantArray 3 + CInt)))) +{-| __unique:__ @test_arraysarray_Example_get_arr_7_const_ptr@ +-} +hs_bindgen_19cc3c6537ef51f0 :: IO (Ptr (IncompleteArray (ConstantArray 3 + CInt))) {-| __unique:__ @test_arraysarray_Example_get_arr_7_const_ptr@ -} -foreign import ccall safe "hs_bindgen_19cc3c6537ef51f0" hs_bindgen_19cc3c6537ef51f0 :: IO (Ptr (IncompleteArray (ConstantArray 3 - CInt))) +hs_bindgen_19cc3c6537ef51f0 = fromBaseForeignType hs_bindgen_19cc3c6537ef51f0_base {-# NOINLINE arr_7_const_ptr #-} {-| Multi-dimensional array of unknown size @@ -2845,9 +3823,15 @@ __defined at:__ @arrays\/array.h:108:18@ __exported by:__ @arrays\/array.h@ -} arr_7_const_ptr = unsafePerformIO hs_bindgen_19cc3c6537ef51f0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9af0285a476aaf26" hs_bindgen_9af0285a476aaf26_base :: BaseForeignType (IO (Ptr Tripletlist)) +{-| __unique:__ @test_arraysarray_Example_get_arr_8_const_ptr@ +-} +hs_bindgen_9af0285a476aaf26 :: IO (Ptr Tripletlist) {-| __unique:__ @test_arraysarray_Example_get_arr_8_const_ptr@ -} -foreign import ccall safe "hs_bindgen_9af0285a476aaf26" hs_bindgen_9af0285a476aaf26 :: IO (Ptr Tripletlist) +hs_bindgen_9af0285a476aaf26 = fromBaseForeignType hs_bindgen_9af0285a476aaf26_base {-# NOINLINE arr_8_const_ptr #-} {-| Multi-dimensional array of unknown size, typedef diff --git a/hs-bindgen/fixtures/attributes/asm/Example/FunPtr.hs b/hs-bindgen/fixtures/attributes/asm/Example/FunPtr.hs index f54b1a4aa..4c719fff7 100644 --- a/hs-bindgen/fixtures/attributes/asm/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/attributes/asm/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -24,10 +25,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_474c22f4687e6d7d" hs_bindgen_474c22f4687e6d7d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_attributesasm_Example_get_asm_labeled_function_ptr@ -} -foreign import ccall unsafe "hs_bindgen_474c22f4687e6d7d" hs_bindgen_474c22f4687e6d7d :: +hs_bindgen_474c22f4687e6d7d :: IO (Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt)) +hs_bindgen_474c22f4687e6d7d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_474c22f4687e6d7d_base {-# NOINLINE asm_labeled_function_ptr #-} diff --git a/hs-bindgen/fixtures/attributes/asm/Example/Global.hs b/hs-bindgen/fixtures/attributes/asm/Example/Global.hs index 798287439..6eadbd0f0 100644 --- a/hs-bindgen/fixtures/attributes/asm/Example/Global.hs +++ b/hs-bindgen/fixtures/attributes/asm/Example/Global.hs @@ -8,6 +8,7 @@ module Example.Global where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -21,10 +22,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f26ea231d0d58288" hs_bindgen_f26ea231d0d58288_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesasm_Example_get_asm_labeled_variable_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f26ea231d0d58288" hs_bindgen_f26ea231d0d58288 :: +hs_bindgen_f26ea231d0d58288 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_f26ea231d0d58288 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f26ea231d0d58288_base {-# NOINLINE asm_labeled_variable_ptr #-} diff --git a/hs-bindgen/fixtures/attributes/asm/Example/Safe.hs b/hs-bindgen/fixtures/attributes/asm/Example/Safe.hs index f70f40617..86c4cf075 100644 --- a/hs-bindgen/fixtures/attributes/asm/Example/Safe.hs +++ b/hs-bindgen/fixtures/attributes/asm/Example/Safe.hs @@ -6,6 +6,7 @@ module Example.Safe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -20,6 +21,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_369133049bfc1e73" asm_labeled_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt -> IO FC.CInt) + {-| __C declaration:__ @asm_labeled_function@ __defined at:__ @attributes\/asm.h:4:5@ @@ -28,7 +34,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_attributesasm_Example_Safe_asm_labeled_function@ -} -foreign import ccall safe "hs_bindgen_369133049bfc1e73" asm_labeled_function :: +asm_labeled_function :: FC.CInt {- ^ __C declaration:__ @x@ -} @@ -36,3 +42,5 @@ foreign import ccall safe "hs_bindgen_369133049bfc1e73" asm_labeled_function :: {- ^ __C declaration:__ @y@ -} -> IO FC.CInt +asm_labeled_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType asm_labeled_function_base diff --git a/hs-bindgen/fixtures/attributes/asm/Example/Unsafe.hs b/hs-bindgen/fixtures/attributes/asm/Example/Unsafe.hs index b7a162596..055f27044 100644 --- a/hs-bindgen/fixtures/attributes/asm/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/attributes/asm/Example/Unsafe.hs @@ -6,6 +6,7 @@ module Example.Unsafe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -20,6 +21,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3ad6c287a2386382" asm_labeled_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt -> IO FC.CInt) + {-| __C declaration:__ @asm_labeled_function@ __defined at:__ @attributes\/asm.h:4:5@ @@ -28,7 +34,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_attributesasm_Example_Unsafe_asm_labeled_function@ -} -foreign import ccall unsafe "hs_bindgen_3ad6c287a2386382" asm_labeled_function :: +asm_labeled_function :: FC.CInt {- ^ __C declaration:__ @x@ -} @@ -36,3 +42,5 @@ foreign import ccall unsafe "hs_bindgen_3ad6c287a2386382" asm_labeled_function : {- ^ __C declaration:__ @y@ -} -> IO FC.CInt +asm_labeled_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType asm_labeled_function_base diff --git a/hs-bindgen/fixtures/attributes/asm/th.txt b/hs-bindgen/fixtures/attributes/asm/th.txt index 1e1815a94..04923961a 100644 --- a/hs-bindgen/fixtures/attributes/asm/th.txt +++ b/hs-bindgen/fixtures/attributes/asm/th.txt @@ -29,6 +29,34 @@ -- { -- return &asm_labeled_variable; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_369133049bfc1e73" asm_labeled_function_base :: BaseForeignType (CInt -> + CInt -> + IO CInt) +{-| __C declaration:__ @asm_labeled_function@ + + __defined at:__ @attributes\/asm.h:4:5@ + + __exported by:__ @attributes\/asm.h@ + + __unique:__ @test_attributesasm_Example_Unsafe_asm_labeled_function@ +-} +asm_labeled_function :: CInt -> CInt -> IO CInt +{-| __C declaration:__ @asm_labeled_function@ + + __defined at:__ @attributes\/asm.h:4:5@ + + __exported by:__ @attributes\/asm.h@ + + __unique:__ @test_attributesasm_Example_Unsafe_asm_labeled_function@ +-} +asm_labeled_function = fromBaseForeignType asm_labeled_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3ad6c287a2386382" asm_labeled_function_base :: BaseForeignType (CInt -> + CInt -> + IO CInt) {-| __C declaration:__ @asm_labeled_function@ __defined at:__ @attributes\/asm.h:4:5@ @@ -37,8 +65,7 @@ __unique:__ @test_attributesasm_Example_Unsafe_asm_labeled_function@ -} -foreign import ccall safe "hs_bindgen_369133049bfc1e73" asm_labeled_function :: CInt -> - CInt -> IO CInt +asm_labeled_function :: CInt -> CInt -> IO CInt {-| __C declaration:__ @asm_labeled_function@ __defined at:__ @attributes\/asm.h:4:5@ @@ -47,13 +74,19 @@ foreign import ccall safe "hs_bindgen_369133049bfc1e73" asm_labeled_function :: __unique:__ @test_attributesasm_Example_Unsafe_asm_labeled_function@ -} -foreign import ccall safe "hs_bindgen_3ad6c287a2386382" asm_labeled_function :: CInt -> - CInt -> IO CInt +asm_labeled_function = fromBaseForeignType asm_labeled_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_474c22f4687e6d7d" hs_bindgen_474c22f4687e6d7d_base :: BaseForeignType (IO (FunPtr (CInt -> + CInt -> + IO CInt))) +{-| __unique:__ @test_attributesasm_Example_get_asm_labeled_function_ptr@ +-} +hs_bindgen_474c22f4687e6d7d :: IO (FunPtr (CInt -> + CInt -> IO CInt)) {-| __unique:__ @test_attributesasm_Example_get_asm_labeled_function_ptr@ -} -foreign import ccall safe "hs_bindgen_474c22f4687e6d7d" hs_bindgen_474c22f4687e6d7d :: IO (FunPtr (CInt -> - CInt -> - IO CInt)) +hs_bindgen_474c22f4687e6d7d = fromBaseForeignType hs_bindgen_474c22f4687e6d7d_base {-# NOINLINE asm_labeled_function_ptr #-} {-| __C declaration:__ @asm_labeled_function@ @@ -69,9 +102,15 @@ asm_labeled_function_ptr :: FunPtr (CInt -> CInt -> IO CInt) __exported by:__ @attributes\/asm.h@ -} asm_labeled_function_ptr = unsafePerformIO hs_bindgen_474c22f4687e6d7d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f26ea231d0d58288" hs_bindgen_f26ea231d0d58288_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesasm_Example_get_asm_labeled_variable_ptr@ +-} +hs_bindgen_f26ea231d0d58288 :: IO (Ptr CInt) {-| __unique:__ @test_attributesasm_Example_get_asm_labeled_variable_ptr@ -} -foreign import ccall safe "hs_bindgen_f26ea231d0d58288" hs_bindgen_f26ea231d0d58288 :: IO (Ptr CInt) +hs_bindgen_f26ea231d0d58288 = fromBaseForeignType hs_bindgen_f26ea231d0d58288_base {-# NOINLINE asm_labeled_variable_ptr #-} {-| __C declaration:__ @asm_labeled_variable@ diff --git a/hs-bindgen/fixtures/attributes/visibility_attributes/Example/FunPtr.hs b/hs-bindgen/fixtures/attributes/visibility_attributes/Example/FunPtr.hs index 3c0caa970..1d19f0661 100644 --- a/hs-bindgen/fixtures/attributes/visibility_attributes/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/attributes/visibility_attributes/Example/FunPtr.hs @@ -7,6 +7,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -194,10 +195,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4fa50edab5785792" hs_bindgen_4fa50edab5785792_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f0_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4fa50edab5785792" hs_bindgen_4fa50edab5785792 :: +hs_bindgen_4fa50edab5785792 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_4fa50edab5785792 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4fa50edab5785792_base {-# NOINLINE f0_ptr #-} @@ -211,10 +219,17 @@ f0_ptr :: Ptr.FunPtr (IO ()) f0_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4fa50edab5785792 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c13821592f55652c" hs_bindgen_c13821592f55652c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c13821592f55652c" hs_bindgen_c13821592f55652c :: +hs_bindgen_c13821592f55652c :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_c13821592f55652c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c13821592f55652c_base {-# NOINLINE f1_ptr #-} @@ -228,10 +243,17 @@ f1_ptr :: Ptr.FunPtr (IO ()) f1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c13821592f55652c +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_eeb8c07b1c7d4892" hs_bindgen_eeb8c07b1c7d4892_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_eeb8c07b1c7d4892" hs_bindgen_eeb8c07b1c7d4892 :: +hs_bindgen_eeb8c07b1c7d4892 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_eeb8c07b1c7d4892 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_eeb8c07b1c7d4892_base {-# NOINLINE f2_ptr #-} @@ -245,10 +267,17 @@ f2_ptr :: Ptr.FunPtr (IO ()) f2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_eeb8c07b1c7d4892 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_22da6befd7cfebfe" hs_bindgen_22da6befd7cfebfe_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_22da6befd7cfebfe" hs_bindgen_22da6befd7cfebfe :: +hs_bindgen_22da6befd7cfebfe :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_22da6befd7cfebfe = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_22da6befd7cfebfe_base {-# NOINLINE f3_ptr #-} @@ -262,10 +291,17 @@ f3_ptr :: Ptr.FunPtr (IO ()) f3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_22da6befd7cfebfe +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_50c8df797d6f5c39" hs_bindgen_50c8df797d6f5c39_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_50c8df797d6f5c39" hs_bindgen_50c8df797d6f5c39 :: +hs_bindgen_50c8df797d6f5c39 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_50c8df797d6f5c39 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_50c8df797d6f5c39_base {-# NOINLINE f4_ptr #-} @@ -279,10 +315,17 @@ f4_ptr :: Ptr.FunPtr (IO ()) f4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_50c8df797d6f5c39 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_495ed8345db40ba2" hs_bindgen_495ed8345db40ba2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_495ed8345db40ba2" hs_bindgen_495ed8345db40ba2 :: +hs_bindgen_495ed8345db40ba2 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_495ed8345db40ba2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_495ed8345db40ba2_base {-# NOINLINE f5_ptr #-} @@ -296,10 +339,17 @@ f5_ptr :: Ptr.FunPtr (IO ()) f5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_495ed8345db40ba2 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2443b169338ac3f7" hs_bindgen_2443b169338ac3f7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f6_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2443b169338ac3f7" hs_bindgen_2443b169338ac3f7 :: +hs_bindgen_2443b169338ac3f7 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_2443b169338ac3f7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2443b169338ac3f7_base {-# NOINLINE f6_ptr #-} @@ -313,10 +363,17 @@ f6_ptr :: Ptr.FunPtr (IO ()) f6_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2443b169338ac3f7 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_949fd6e2edb95316" hs_bindgen_949fd6e2edb95316_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f7_ptr@ -} -foreign import ccall unsafe "hs_bindgen_949fd6e2edb95316" hs_bindgen_949fd6e2edb95316 :: +hs_bindgen_949fd6e2edb95316 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_949fd6e2edb95316 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_949fd6e2edb95316_base {-# NOINLINE f7_ptr #-} @@ -330,10 +387,17 @@ f7_ptr :: Ptr.FunPtr (IO ()) f7_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_949fd6e2edb95316 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f474c8449f3cc4f7" hs_bindgen_f474c8449f3cc4f7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f8_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f474c8449f3cc4f7" hs_bindgen_f474c8449f3cc4f7 :: +hs_bindgen_f474c8449f3cc4f7 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_f474c8449f3cc4f7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f474c8449f3cc4f7_base {-# NOINLINE f8_ptr #-} @@ -347,10 +411,17 @@ f8_ptr :: Ptr.FunPtr (IO ()) f8_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f474c8449f3cc4f7 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3646a569205d32fd" hs_bindgen_3646a569205d32fd_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f9_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3646a569205d32fd" hs_bindgen_3646a569205d32fd :: +hs_bindgen_3646a569205d32fd :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_3646a569205d32fd = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3646a569205d32fd_base {-# NOINLINE f9_ptr #-} @@ -364,10 +435,17 @@ f9_ptr :: Ptr.FunPtr (IO ()) f9_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3646a569205d32fd +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3538a19bdbcce7dd" hs_bindgen_3538a19bdbcce7dd_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f10_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3538a19bdbcce7dd" hs_bindgen_3538a19bdbcce7dd :: +hs_bindgen_3538a19bdbcce7dd :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_3538a19bdbcce7dd = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3538a19bdbcce7dd_base {-# NOINLINE f10_ptr #-} @@ -381,10 +459,17 @@ f10_ptr :: Ptr.FunPtr (IO ()) f10_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3538a19bdbcce7dd +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_212757456c565a4f" hs_bindgen_212757456c565a4f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f11_ptr@ -} -foreign import ccall unsafe "hs_bindgen_212757456c565a4f" hs_bindgen_212757456c565a4f :: +hs_bindgen_212757456c565a4f :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_212757456c565a4f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_212757456c565a4f_base {-# NOINLINE f11_ptr #-} @@ -398,10 +483,17 @@ f11_ptr :: Ptr.FunPtr (IO ()) f11_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_212757456c565a4f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d1984175b52d2a8a" hs_bindgen_d1984175b52d2a8a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f12_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d1984175b52d2a8a" hs_bindgen_d1984175b52d2a8a :: +hs_bindgen_d1984175b52d2a8a :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_d1984175b52d2a8a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d1984175b52d2a8a_base {-# NOINLINE f12_ptr #-} @@ -415,10 +507,17 @@ f12_ptr :: Ptr.FunPtr (IO ()) f12_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d1984175b52d2a8a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_318302468a1f1e5b" hs_bindgen_318302468a1f1e5b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f13_ptr@ -} -foreign import ccall unsafe "hs_bindgen_318302468a1f1e5b" hs_bindgen_318302468a1f1e5b :: +hs_bindgen_318302468a1f1e5b :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_318302468a1f1e5b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_318302468a1f1e5b_base {-# NOINLINE f13_ptr #-} @@ -432,10 +531,17 @@ f13_ptr :: Ptr.FunPtr (IO ()) f13_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_318302468a1f1e5b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ad80c7d6dbd5cae9" hs_bindgen_ad80c7d6dbd5cae9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f14_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ad80c7d6dbd5cae9" hs_bindgen_ad80c7d6dbd5cae9 :: +hs_bindgen_ad80c7d6dbd5cae9 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_ad80c7d6dbd5cae9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ad80c7d6dbd5cae9_base {-# NOINLINE f14_ptr #-} @@ -449,10 +555,17 @@ f14_ptr :: Ptr.FunPtr (IO ()) f14_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_ad80c7d6dbd5cae9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4cfe90744e725641" hs_bindgen_4cfe90744e725641_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f15_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4cfe90744e725641" hs_bindgen_4cfe90744e725641 :: +hs_bindgen_4cfe90744e725641 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_4cfe90744e725641 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4cfe90744e725641_base {-# NOINLINE f15_ptr #-} @@ -466,10 +579,17 @@ f15_ptr :: Ptr.FunPtr (IO ()) f15_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4cfe90744e725641 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6d14737fe874b3cb" hs_bindgen_6d14737fe874b3cb_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f16_ptr@ -} -foreign import ccall unsafe "hs_bindgen_6d14737fe874b3cb" hs_bindgen_6d14737fe874b3cb :: +hs_bindgen_6d14737fe874b3cb :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_6d14737fe874b3cb = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_6d14737fe874b3cb_base {-# NOINLINE f16_ptr #-} @@ -483,10 +603,17 @@ f16_ptr :: Ptr.FunPtr (IO ()) f16_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_6d14737fe874b3cb +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_09e8fbff66923029" hs_bindgen_09e8fbff66923029_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f17_ptr@ -} -foreign import ccall unsafe "hs_bindgen_09e8fbff66923029" hs_bindgen_09e8fbff66923029 :: +hs_bindgen_09e8fbff66923029 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_09e8fbff66923029 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_09e8fbff66923029_base {-# NOINLINE f17_ptr #-} @@ -500,10 +627,17 @@ f17_ptr :: Ptr.FunPtr (IO ()) f17_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_09e8fbff66923029 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_42a26b5e01e5cd71" hs_bindgen_42a26b5e01e5cd71_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f18_ptr@ -} -foreign import ccall unsafe "hs_bindgen_42a26b5e01e5cd71" hs_bindgen_42a26b5e01e5cd71 :: +hs_bindgen_42a26b5e01e5cd71 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_42a26b5e01e5cd71 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_42a26b5e01e5cd71_base {-# NOINLINE f18_ptr #-} @@ -517,10 +651,17 @@ f18_ptr :: Ptr.FunPtr (IO ()) f18_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_42a26b5e01e5cd71 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5176a5601da0207c" hs_bindgen_5176a5601da0207c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f19_ptr@ -} -foreign import ccall unsafe "hs_bindgen_5176a5601da0207c" hs_bindgen_5176a5601da0207c :: +hs_bindgen_5176a5601da0207c :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_5176a5601da0207c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_5176a5601da0207c_base {-# NOINLINE f19_ptr #-} @@ -534,10 +675,17 @@ f19_ptr :: Ptr.FunPtr (IO ()) f19_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_5176a5601da0207c +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4eaefbdc60946d59" hs_bindgen_4eaefbdc60946d59_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f20_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4eaefbdc60946d59" hs_bindgen_4eaefbdc60946d59 :: +hs_bindgen_4eaefbdc60946d59 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_4eaefbdc60946d59 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4eaefbdc60946d59_base {-# NOINLINE f20_ptr #-} @@ -551,10 +699,17 @@ f20_ptr :: Ptr.FunPtr (IO ()) f20_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4eaefbdc60946d59 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_41dfc77185a5f202" hs_bindgen_41dfc77185a5f202_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f21_ptr@ -} -foreign import ccall unsafe "hs_bindgen_41dfc77185a5f202" hs_bindgen_41dfc77185a5f202 :: +hs_bindgen_41dfc77185a5f202 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_41dfc77185a5f202 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_41dfc77185a5f202_base {-# NOINLINE f21_ptr #-} @@ -568,10 +723,17 @@ f21_ptr :: Ptr.FunPtr (IO ()) f21_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_41dfc77185a5f202 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a5c1f65da28b559c" hs_bindgen_a5c1f65da28b559c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f22_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a5c1f65da28b559c" hs_bindgen_a5c1f65da28b559c :: +hs_bindgen_a5c1f65da28b559c :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_a5c1f65da28b559c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a5c1f65da28b559c_base {-# NOINLINE f22_ptr #-} @@ -585,10 +747,17 @@ f22_ptr :: Ptr.FunPtr (IO ()) f22_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a5c1f65da28b559c +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6ea6382845ca7a26" hs_bindgen_6ea6382845ca7a26_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f23_ptr@ -} -foreign import ccall unsafe "hs_bindgen_6ea6382845ca7a26" hs_bindgen_6ea6382845ca7a26 :: +hs_bindgen_6ea6382845ca7a26 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_6ea6382845ca7a26 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_6ea6382845ca7a26_base {-# NOINLINE f23_ptr #-} @@ -602,10 +771,17 @@ f23_ptr :: Ptr.FunPtr (IO ()) f23_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_6ea6382845ca7a26 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8f9343a5bdbbe418" hs_bindgen_8f9343a5bdbbe418_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f24_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8f9343a5bdbbe418" hs_bindgen_8f9343a5bdbbe418 :: +hs_bindgen_8f9343a5bdbbe418 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_8f9343a5bdbbe418 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8f9343a5bdbbe418_base {-# NOINLINE f24_ptr #-} @@ -619,10 +795,17 @@ f24_ptr :: Ptr.FunPtr (IO ()) f24_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8f9343a5bdbbe418 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8185701609035828" hs_bindgen_8185701609035828_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f25_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8185701609035828" hs_bindgen_8185701609035828 :: +hs_bindgen_8185701609035828 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_8185701609035828 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8185701609035828_base {-# NOINLINE f25_ptr #-} @@ -636,10 +819,17 @@ f25_ptr :: Ptr.FunPtr (IO ()) f25_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8185701609035828 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cba990b34ea47f08" hs_bindgen_cba990b34ea47f08_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f26_ptr@ -} -foreign import ccall unsafe "hs_bindgen_cba990b34ea47f08" hs_bindgen_cba990b34ea47f08 :: +hs_bindgen_cba990b34ea47f08 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_cba990b34ea47f08 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_cba990b34ea47f08_base {-# NOINLINE f26_ptr #-} @@ -653,10 +843,17 @@ f26_ptr :: Ptr.FunPtr (IO ()) f26_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_cba990b34ea47f08 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d20da035780e1286" hs_bindgen_d20da035780e1286_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f27_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d20da035780e1286" hs_bindgen_d20da035780e1286 :: +hs_bindgen_d20da035780e1286 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_d20da035780e1286 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d20da035780e1286_base {-# NOINLINE f27_ptr #-} @@ -670,10 +867,17 @@ f27_ptr :: Ptr.FunPtr (IO ()) f27_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d20da035780e1286 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_53755375b7f63b0d" hs_bindgen_53755375b7f63b0d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f28_ptr@ -} -foreign import ccall unsafe "hs_bindgen_53755375b7f63b0d" hs_bindgen_53755375b7f63b0d :: +hs_bindgen_53755375b7f63b0d :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_53755375b7f63b0d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_53755375b7f63b0d_base {-# NOINLINE f28_ptr #-} @@ -687,10 +891,17 @@ f28_ptr :: Ptr.FunPtr (IO ()) f28_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_53755375b7f63b0d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cba78220552029e8" hs_bindgen_cba78220552029e8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f29_ptr@ -} -foreign import ccall unsafe "hs_bindgen_cba78220552029e8" hs_bindgen_cba78220552029e8 :: +hs_bindgen_cba78220552029e8 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_cba78220552029e8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_cba78220552029e8_base {-# NOINLINE f29_ptr #-} diff --git a/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Global.hs b/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Global.hs index 29a99a4e1..f8efc939e 100644 --- a/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Global.hs +++ b/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Global.hs @@ -8,6 +8,7 @@ module Example.Global where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -135,10 +136,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_882dcb40c6ad1461" hs_bindgen_882dcb40c6ad1461_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i0_ptr@ -} -foreign import ccall unsafe "hs_bindgen_882dcb40c6ad1461" hs_bindgen_882dcb40c6ad1461 :: +hs_bindgen_882dcb40c6ad1461 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_882dcb40c6ad1461 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_882dcb40c6ad1461_base {-# NOINLINE i0_ptr #-} @@ -152,10 +160,17 @@ i0_ptr :: Ptr.Ptr FC.CInt i0_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_882dcb40c6ad1461 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_67e8ccdb1d25e3ae" hs_bindgen_67e8ccdb1d25e3ae_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_67e8ccdb1d25e3ae" hs_bindgen_67e8ccdb1d25e3ae :: +hs_bindgen_67e8ccdb1d25e3ae :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_67e8ccdb1d25e3ae = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_67e8ccdb1d25e3ae_base {-# NOINLINE i1_ptr #-} @@ -169,10 +184,17 @@ i1_ptr :: Ptr.Ptr FC.CInt i1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_67e8ccdb1d25e3ae +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1ce9eb133565b90a" hs_bindgen_1ce9eb133565b90a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1ce9eb133565b90a" hs_bindgen_1ce9eb133565b90a :: +hs_bindgen_1ce9eb133565b90a :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_1ce9eb133565b90a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1ce9eb133565b90a_base {-# NOINLINE i2_ptr #-} @@ -186,10 +208,17 @@ i2_ptr :: Ptr.Ptr FC.CInt i2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1ce9eb133565b90a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_00fce981bcb56c1a" hs_bindgen_00fce981bcb56c1a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_00fce981bcb56c1a" hs_bindgen_00fce981bcb56c1a :: +hs_bindgen_00fce981bcb56c1a :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_00fce981bcb56c1a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_00fce981bcb56c1a_base {-# NOINLINE i3_ptr #-} @@ -203,10 +232,17 @@ i3_ptr :: Ptr.Ptr FC.CInt i3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_00fce981bcb56c1a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c4b37069d8e025e5" hs_bindgen_c4b37069d8e025e5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c4b37069d8e025e5" hs_bindgen_c4b37069d8e025e5 :: +hs_bindgen_c4b37069d8e025e5 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_c4b37069d8e025e5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c4b37069d8e025e5_base {-# NOINLINE i4_ptr #-} @@ -220,10 +256,17 @@ i4_ptr :: Ptr.Ptr FC.CInt i4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c4b37069d8e025e5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bd0f182728abf16f" hs_bindgen_bd0f182728abf16f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bd0f182728abf16f" hs_bindgen_bd0f182728abf16f :: +hs_bindgen_bd0f182728abf16f :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_bd0f182728abf16f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bd0f182728abf16f_base {-# NOINLINE i5_ptr #-} @@ -237,10 +280,17 @@ i5_ptr :: Ptr.Ptr FC.CInt i5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bd0f182728abf16f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c53b7cfddc89a6b9" hs_bindgen_c53b7cfddc89a6b9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i6_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c53b7cfddc89a6b9" hs_bindgen_c53b7cfddc89a6b9 :: +hs_bindgen_c53b7cfddc89a6b9 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_c53b7cfddc89a6b9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c53b7cfddc89a6b9_base {-# NOINLINE i6_ptr #-} @@ -254,10 +304,17 @@ i6_ptr :: Ptr.Ptr FC.CInt i6_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c53b7cfddc89a6b9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_72edacaf16ab0c81" hs_bindgen_72edacaf16ab0c81_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i7_ptr@ -} -foreign import ccall unsafe "hs_bindgen_72edacaf16ab0c81" hs_bindgen_72edacaf16ab0c81 :: +hs_bindgen_72edacaf16ab0c81 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_72edacaf16ab0c81 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_72edacaf16ab0c81_base {-# NOINLINE i7_ptr #-} @@ -271,10 +328,17 @@ i7_ptr :: Ptr.Ptr FC.CInt i7_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_72edacaf16ab0c81 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1b48c1380972701f" hs_bindgen_1b48c1380972701f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i8_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1b48c1380972701f" hs_bindgen_1b48c1380972701f :: +hs_bindgen_1b48c1380972701f :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_1b48c1380972701f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1b48c1380972701f_base {-# NOINLINE i8_ptr #-} @@ -288,10 +352,17 @@ i8_ptr :: Ptr.Ptr FC.CInt i8_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1b48c1380972701f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_63a2d96d25b60025" hs_bindgen_63a2d96d25b60025_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i9_ptr@ -} -foreign import ccall unsafe "hs_bindgen_63a2d96d25b60025" hs_bindgen_63a2d96d25b60025 :: +hs_bindgen_63a2d96d25b60025 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_63a2d96d25b60025 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_63a2d96d25b60025_base {-# NOINLINE i9_ptr #-} @@ -305,10 +376,17 @@ i9_ptr :: Ptr.Ptr FC.CInt i9_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_63a2d96d25b60025 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_181bf3398f5fd2d3" hs_bindgen_181bf3398f5fd2d3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i10_ptr@ -} -foreign import ccall unsafe "hs_bindgen_181bf3398f5fd2d3" hs_bindgen_181bf3398f5fd2d3 :: +hs_bindgen_181bf3398f5fd2d3 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_181bf3398f5fd2d3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_181bf3398f5fd2d3_base {-# NOINLINE i10_ptr #-} @@ -322,10 +400,17 @@ i10_ptr :: Ptr.Ptr FC.CInt i10_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_181bf3398f5fd2d3 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_46ba7aba6f2491ca" hs_bindgen_46ba7aba6f2491ca_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i11_ptr@ -} -foreign import ccall unsafe "hs_bindgen_46ba7aba6f2491ca" hs_bindgen_46ba7aba6f2491ca :: +hs_bindgen_46ba7aba6f2491ca :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_46ba7aba6f2491ca = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_46ba7aba6f2491ca_base {-# NOINLINE i11_ptr #-} @@ -339,10 +424,17 @@ i11_ptr :: Ptr.Ptr FC.CInt i11_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_46ba7aba6f2491ca +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d9e0a613cbcc9f3e" hs_bindgen_d9e0a613cbcc9f3e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i12_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d9e0a613cbcc9f3e" hs_bindgen_d9e0a613cbcc9f3e :: +hs_bindgen_d9e0a613cbcc9f3e :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_d9e0a613cbcc9f3e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d9e0a613cbcc9f3e_base {-# NOINLINE i12_ptr #-} @@ -356,10 +448,17 @@ i12_ptr :: Ptr.Ptr FC.CInt i12_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d9e0a613cbcc9f3e +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d02e91d8b8f37508" hs_bindgen_d02e91d8b8f37508_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i13_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d02e91d8b8f37508" hs_bindgen_d02e91d8b8f37508 :: +hs_bindgen_d02e91d8b8f37508 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_d02e91d8b8f37508 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d02e91d8b8f37508_base {-# NOINLINE i13_ptr #-} @@ -373,10 +472,17 @@ i13_ptr :: Ptr.Ptr FC.CInt i13_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d02e91d8b8f37508 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fc03a1c74eda2944" hs_bindgen_fc03a1c74eda2944_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i14_ptr@ -} -foreign import ccall unsafe "hs_bindgen_fc03a1c74eda2944" hs_bindgen_fc03a1c74eda2944 :: +hs_bindgen_fc03a1c74eda2944 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_fc03a1c74eda2944 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_fc03a1c74eda2944_base {-# NOINLINE i14_ptr #-} @@ -390,10 +496,17 @@ i14_ptr :: Ptr.Ptr FC.CInt i14_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_fc03a1c74eda2944 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1d303eaadfd446c8" hs_bindgen_1d303eaadfd446c8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i15_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1d303eaadfd446c8" hs_bindgen_1d303eaadfd446c8 :: +hs_bindgen_1d303eaadfd446c8 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_1d303eaadfd446c8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1d303eaadfd446c8_base {-# NOINLINE i15_ptr #-} @@ -407,10 +520,17 @@ i15_ptr :: Ptr.Ptr FC.CInt i15_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1d303eaadfd446c8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_625545a81d12a4a3" hs_bindgen_625545a81d12a4a3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i16_ptr@ -} -foreign import ccall unsafe "hs_bindgen_625545a81d12a4a3" hs_bindgen_625545a81d12a4a3 :: +hs_bindgen_625545a81d12a4a3 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_625545a81d12a4a3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_625545a81d12a4a3_base {-# NOINLINE i16_ptr #-} @@ -424,10 +544,17 @@ i16_ptr :: Ptr.Ptr FC.CInt i16_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_625545a81d12a4a3 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c8e2d4272fd70085" hs_bindgen_c8e2d4272fd70085_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i17_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c8e2d4272fd70085" hs_bindgen_c8e2d4272fd70085 :: +hs_bindgen_c8e2d4272fd70085 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_c8e2d4272fd70085 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c8e2d4272fd70085_base {-# NOINLINE i17_ptr #-} @@ -441,10 +568,17 @@ i17_ptr :: Ptr.Ptr FC.CInt i17_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c8e2d4272fd70085 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_50f4901f7ed0ca1d" hs_bindgen_50f4901f7ed0ca1d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i18_ptr@ -} -foreign import ccall unsafe "hs_bindgen_50f4901f7ed0ca1d" hs_bindgen_50f4901f7ed0ca1d :: +hs_bindgen_50f4901f7ed0ca1d :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_50f4901f7ed0ca1d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_50f4901f7ed0ca1d_base {-# NOINLINE i18_ptr #-} @@ -458,10 +592,17 @@ i18_ptr :: Ptr.Ptr FC.CInt i18_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_50f4901f7ed0ca1d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e70a0a7f087993cf" hs_bindgen_e70a0a7f087993cf_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i19_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e70a0a7f087993cf" hs_bindgen_e70a0a7f087993cf :: +hs_bindgen_e70a0a7f087993cf :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_e70a0a7f087993cf = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e70a0a7f087993cf_base {-# NOINLINE i19_ptr #-} diff --git a/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Safe.hs b/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Safe.hs index 31d824199..e4417cc46 100644 --- a/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Safe.hs +++ b/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Safe.hs @@ -5,6 +5,7 @@ module Example.Safe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -132,6 +133,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e64a83c5f7f51679" f0_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @f0@ __defined at:__ @attributes\/visibility_attributes.h:17:56@ @@ -140,8 +146,15 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_attributesvisibility_attribut_Example_Safe_f0@ -} -foreign import ccall safe "hs_bindgen_e64a83c5f7f51679" f0 :: +f0 :: IO () +f0 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f0_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8881b0f4ce94e440" f1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f1@ @@ -151,8 +164,15 @@ foreign import ccall safe "hs_bindgen_e64a83c5f7f51679" f0 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f1@ -} -foreign import ccall safe "hs_bindgen_8881b0f4ce94e440" f1 :: +f1 :: IO () +f1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4ede7f4c96b4d1b5" f2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f2@ @@ -162,8 +182,15 @@ foreign import ccall safe "hs_bindgen_8881b0f4ce94e440" f1 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f2@ -} -foreign import ccall safe "hs_bindgen_4ede7f4c96b4d1b5" f2 :: +f2 :: IO () +f2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_018f1e15132ff973" f3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f3@ @@ -173,8 +200,15 @@ foreign import ccall safe "hs_bindgen_4ede7f4c96b4d1b5" f2 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f3@ -} -foreign import ccall safe "hs_bindgen_018f1e15132ff973" f3 :: +f3 :: IO () +f3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9d93cf33b1a833d1" f4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f4@ @@ -184,8 +218,15 @@ foreign import ccall safe "hs_bindgen_018f1e15132ff973" f3 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f4@ -} -foreign import ccall safe "hs_bindgen_9d93cf33b1a833d1" f4 :: +f4 :: IO () +f4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f4_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_959298c4e5cb061a" f5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f5@ @@ -195,8 +236,15 @@ foreign import ccall safe "hs_bindgen_9d93cf33b1a833d1" f4 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f5@ -} -foreign import ccall safe "hs_bindgen_959298c4e5cb061a" f5 :: +f5 :: IO () +f5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f5_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_218297218a4953d6" f6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f6@ @@ -206,8 +254,15 @@ foreign import ccall safe "hs_bindgen_959298c4e5cb061a" f5 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f6@ -} -foreign import ccall safe "hs_bindgen_218297218a4953d6" f6 :: +f6 :: IO () +f6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f6_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_df320fe3d4683ff9" f7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f7@ @@ -217,8 +272,15 @@ foreign import ccall safe "hs_bindgen_218297218a4953d6" f6 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f7@ -} -foreign import ccall safe "hs_bindgen_df320fe3d4683ff9" f7 :: +f7 :: IO () +f7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f7_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cd613f46d2e06e18" f8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f8@ @@ -228,8 +290,15 @@ foreign import ccall safe "hs_bindgen_df320fe3d4683ff9" f7 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f8@ -} -foreign import ccall safe "hs_bindgen_cd613f46d2e06e18" f8 :: +f8 :: IO () +f8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f8_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_67774b3f22bd7286" f9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f9@ @@ -239,8 +308,15 @@ foreign import ccall safe "hs_bindgen_cd613f46d2e06e18" f8 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f9@ -} -foreign import ccall safe "hs_bindgen_67774b3f22bd7286" f9 :: +f9 :: IO () +f9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f9_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dbbd2e0417380ce9" f10_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f10@ @@ -250,8 +326,15 @@ foreign import ccall safe "hs_bindgen_67774b3f22bd7286" f9 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f10@ -} -foreign import ccall safe "hs_bindgen_dbbd2e0417380ce9" f10 :: +f10 :: IO () +f10 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f10_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9d8fadad3f85e1fc" f11_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f11@ @@ -261,8 +344,15 @@ foreign import ccall safe "hs_bindgen_dbbd2e0417380ce9" f10 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f11@ -} -foreign import ccall safe "hs_bindgen_9d8fadad3f85e1fc" f11 :: +f11 :: IO () +f11 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f11_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_558a7ef50878f4b2" f12_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f12@ @@ -272,8 +362,15 @@ foreign import ccall safe "hs_bindgen_9d8fadad3f85e1fc" f11 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f12@ -} -foreign import ccall safe "hs_bindgen_558a7ef50878f4b2" f12 :: +f12 :: IO () +f12 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f12_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_30add751959aac79" f13_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f13@ @@ -283,8 +380,15 @@ foreign import ccall safe "hs_bindgen_558a7ef50878f4b2" f12 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f13@ -} -foreign import ccall safe "hs_bindgen_30add751959aac79" f13 :: +f13 :: IO () +f13 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f13_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_06b989df2d3622ad" f14_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f14@ @@ -294,8 +398,15 @@ foreign import ccall safe "hs_bindgen_30add751959aac79" f13 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f14@ -} -foreign import ccall safe "hs_bindgen_06b989df2d3622ad" f14 :: +f14 :: IO () +f14 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f14_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_11627343b78e6e76" f15_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f15@ @@ -305,8 +416,15 @@ foreign import ccall safe "hs_bindgen_06b989df2d3622ad" f14 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f15@ -} -foreign import ccall safe "hs_bindgen_11627343b78e6e76" f15 :: +f15 :: IO () +f15 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f15_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5d3aa9a924674163" f16_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f16@ @@ -316,8 +434,15 @@ foreign import ccall safe "hs_bindgen_11627343b78e6e76" f15 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f16@ -} -foreign import ccall safe "hs_bindgen_5d3aa9a924674163" f16 :: +f16 :: IO () +f16 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f16_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_65abad67aeb6b955" f17_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f17@ @@ -327,8 +452,15 @@ foreign import ccall safe "hs_bindgen_5d3aa9a924674163" f16 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f17@ -} -foreign import ccall safe "hs_bindgen_65abad67aeb6b955" f17 :: +f17 :: IO () +f17 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f17_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0350778b298751b2" f18_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f18@ @@ -338,8 +470,15 @@ foreign import ccall safe "hs_bindgen_65abad67aeb6b955" f17 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f18@ -} -foreign import ccall safe "hs_bindgen_0350778b298751b2" f18 :: +f18 :: IO () +f18 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f18_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aacba18c2fb3dae1" f19_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f19@ @@ -349,8 +488,15 @@ foreign import ccall safe "hs_bindgen_0350778b298751b2" f18 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f19@ -} -foreign import ccall safe "hs_bindgen_aacba18c2fb3dae1" f19 :: +f19 :: IO () +f19 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f19_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_023f4d5d2a56d2e9" f20_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f20@ @@ -360,8 +506,15 @@ foreign import ccall safe "hs_bindgen_aacba18c2fb3dae1" f19 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f20@ -} -foreign import ccall safe "hs_bindgen_023f4d5d2a56d2e9" f20 :: +f20 :: IO () +f20 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f20_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3a70db9f9e280b85" f21_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f21@ @@ -371,8 +524,15 @@ foreign import ccall safe "hs_bindgen_023f4d5d2a56d2e9" f20 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f21@ -} -foreign import ccall safe "hs_bindgen_3a70db9f9e280b85" f21 :: +f21 :: IO () +f21 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f21_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a4fc9586b7510ea6" f22_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f22@ @@ -382,8 +542,15 @@ foreign import ccall safe "hs_bindgen_3a70db9f9e280b85" f21 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f22@ -} -foreign import ccall safe "hs_bindgen_a4fc9586b7510ea6" f22 :: +f22 :: IO () +f22 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f22_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c25df69a5f23a9b9" f23_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f23@ @@ -393,8 +560,15 @@ foreign import ccall safe "hs_bindgen_a4fc9586b7510ea6" f22 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f23@ -} -foreign import ccall safe "hs_bindgen_c25df69a5f23a9b9" f23 :: +f23 :: IO () +f23 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f23_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_909c5201154b4617" f24_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f24@ @@ -404,8 +578,15 @@ foreign import ccall safe "hs_bindgen_c25df69a5f23a9b9" f23 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f24@ -} -foreign import ccall safe "hs_bindgen_909c5201154b4617" f24 :: +f24 :: IO () +f24 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f24_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dfbd362260cd0fba" f25_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f25@ @@ -415,8 +596,15 @@ foreign import ccall safe "hs_bindgen_909c5201154b4617" f24 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f25@ -} -foreign import ccall safe "hs_bindgen_dfbd362260cd0fba" f25 :: +f25 :: IO () +f25 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f25_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d9c4d8bc1b7d8a59" f26_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f26@ @@ -426,8 +614,15 @@ foreign import ccall safe "hs_bindgen_dfbd362260cd0fba" f25 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f26@ -} -foreign import ccall safe "hs_bindgen_d9c4d8bc1b7d8a59" f26 :: +f26 :: IO () +f26 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f26_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_71a726a6d6e62f14" f27_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f27@ @@ -437,8 +632,15 @@ foreign import ccall safe "hs_bindgen_d9c4d8bc1b7d8a59" f26 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f27@ -} -foreign import ccall safe "hs_bindgen_71a726a6d6e62f14" f27 :: +f27 :: IO () +f27 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f27_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_70f35808778a1423" f28_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f28@ @@ -448,8 +650,15 @@ foreign import ccall safe "hs_bindgen_71a726a6d6e62f14" f27 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f28@ -} -foreign import ccall safe "hs_bindgen_70f35808778a1423" f28 :: +f28 :: IO () +f28 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f28_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7ba7293cedb52447" f29_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f29@ @@ -459,5 +668,7 @@ foreign import ccall safe "hs_bindgen_70f35808778a1423" f28 :: __unique:__ @test_attributesvisibility_attribut_Example_Safe_f29@ -} -foreign import ccall safe "hs_bindgen_7ba7293cedb52447" f29 :: +f29 :: IO () +f29 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f29_base diff --git a/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Unsafe.hs b/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Unsafe.hs index 9379bed18..dc27555e6 100644 --- a/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/attributes/visibility_attributes/Example/Unsafe.hs @@ -5,6 +5,7 @@ module Example.Unsafe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -132,6 +133,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_df56d82c9186c794" f0_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @f0@ __defined at:__ @attributes\/visibility_attributes.h:17:56@ @@ -140,8 +146,15 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f0@ -} -foreign import ccall unsafe "hs_bindgen_df56d82c9186c794" f0 :: +f0 :: IO () +f0 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f0_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2e25b1147da3cdee" f1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f1@ @@ -151,8 +164,15 @@ foreign import ccall unsafe "hs_bindgen_df56d82c9186c794" f0 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f1@ -} -foreign import ccall unsafe "hs_bindgen_2e25b1147da3cdee" f1 :: +f1 :: IO () +f1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c57341dd645988f6" f2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f2@ @@ -162,8 +182,15 @@ foreign import ccall unsafe "hs_bindgen_2e25b1147da3cdee" f1 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f2@ -} -foreign import ccall unsafe "hs_bindgen_c57341dd645988f6" f2 :: +f2 :: IO () +f2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5858f33f5b12f541" f3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f3@ @@ -173,8 +200,15 @@ foreign import ccall unsafe "hs_bindgen_c57341dd645988f6" f2 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f3@ -} -foreign import ccall unsafe "hs_bindgen_5858f33f5b12f541" f3 :: +f3 :: IO () +f3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d57b75423078a644" f4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f4@ @@ -184,8 +218,15 @@ foreign import ccall unsafe "hs_bindgen_5858f33f5b12f541" f3 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f4@ -} -foreign import ccall unsafe "hs_bindgen_d57b75423078a644" f4 :: +f4 :: IO () +f4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f4_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d7e35ffb8ef15009" f5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f5@ @@ -195,8 +236,15 @@ foreign import ccall unsafe "hs_bindgen_d57b75423078a644" f4 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f5@ -} -foreign import ccall unsafe "hs_bindgen_d7e35ffb8ef15009" f5 :: +f5 :: IO () +f5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f5_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_de345dceb6694e2e" f6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f6@ @@ -206,8 +254,15 @@ foreign import ccall unsafe "hs_bindgen_d7e35ffb8ef15009" f5 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f6@ -} -foreign import ccall unsafe "hs_bindgen_de345dceb6694e2e" f6 :: +f6 :: IO () +f6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f6_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_df2fd4ea47789bb8" f7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f7@ @@ -217,8 +272,15 @@ foreign import ccall unsafe "hs_bindgen_de345dceb6694e2e" f6 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f7@ -} -foreign import ccall unsafe "hs_bindgen_df2fd4ea47789bb8" f7 :: +f7 :: IO () +f7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f7_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a49e6066d8dd0628" f8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f8@ @@ -228,8 +290,15 @@ foreign import ccall unsafe "hs_bindgen_df2fd4ea47789bb8" f7 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f8@ -} -foreign import ccall unsafe "hs_bindgen_a49e6066d8dd0628" f8 :: +f8 :: IO () +f8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f8_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e94ceb5e10d07a59" f9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f9@ @@ -239,8 +308,15 @@ foreign import ccall unsafe "hs_bindgen_a49e6066d8dd0628" f8 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f9@ -} -foreign import ccall unsafe "hs_bindgen_e94ceb5e10d07a59" f9 :: +f9 :: IO () +f9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f9_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d329fc979eb3d29e" f10_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f10@ @@ -250,8 +326,15 @@ foreign import ccall unsafe "hs_bindgen_e94ceb5e10d07a59" f9 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f10@ -} -foreign import ccall unsafe "hs_bindgen_d329fc979eb3d29e" f10 :: +f10 :: IO () +f10 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f10_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9f7176bfdf1871cf" f11_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f11@ @@ -261,8 +344,15 @@ foreign import ccall unsafe "hs_bindgen_d329fc979eb3d29e" f10 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f11@ -} -foreign import ccall unsafe "hs_bindgen_9f7176bfdf1871cf" f11 :: +f11 :: IO () +f11 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f11_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d06a71df91d678f1" f12_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f12@ @@ -272,8 +362,15 @@ foreign import ccall unsafe "hs_bindgen_9f7176bfdf1871cf" f11 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f12@ -} -foreign import ccall unsafe "hs_bindgen_d06a71df91d678f1" f12 :: +f12 :: IO () +f12 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f12_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_32916e0b4775516d" f13_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f13@ @@ -283,8 +380,15 @@ foreign import ccall unsafe "hs_bindgen_d06a71df91d678f1" f12 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f13@ -} -foreign import ccall unsafe "hs_bindgen_32916e0b4775516d" f13 :: +f13 :: IO () +f13 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f13_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_56f26ce5de7906a8" f14_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f14@ @@ -294,8 +398,15 @@ foreign import ccall unsafe "hs_bindgen_32916e0b4775516d" f13 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f14@ -} -foreign import ccall unsafe "hs_bindgen_56f26ce5de7906a8" f14 :: +f14 :: IO () +f14 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f14_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fd2972764f48a143" f15_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f15@ @@ -305,8 +416,15 @@ foreign import ccall unsafe "hs_bindgen_56f26ce5de7906a8" f14 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f15@ -} -foreign import ccall unsafe "hs_bindgen_fd2972764f48a143" f15 :: +f15 :: IO () +f15 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f15_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f63a042e539ff8b6" f16_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f16@ @@ -316,8 +434,15 @@ foreign import ccall unsafe "hs_bindgen_fd2972764f48a143" f15 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f16@ -} -foreign import ccall unsafe "hs_bindgen_f63a042e539ff8b6" f16 :: +f16 :: IO () +f16 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f16_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1ae5adf1961e06f6" f17_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f17@ @@ -327,8 +452,15 @@ foreign import ccall unsafe "hs_bindgen_f63a042e539ff8b6" f16 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f17@ -} -foreign import ccall unsafe "hs_bindgen_1ae5adf1961e06f6" f17 :: +f17 :: IO () +f17 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f17_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cf7978ab53dc8140" f18_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f18@ @@ -338,8 +470,15 @@ foreign import ccall unsafe "hs_bindgen_1ae5adf1961e06f6" f17 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f18@ -} -foreign import ccall unsafe "hs_bindgen_cf7978ab53dc8140" f18 :: +f18 :: IO () +f18 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f18_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f81ec562e6b7dc0f" f19_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f19@ @@ -349,8 +488,15 @@ foreign import ccall unsafe "hs_bindgen_cf7978ab53dc8140" f18 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f19@ -} -foreign import ccall unsafe "hs_bindgen_f81ec562e6b7dc0f" f19 :: +f19 :: IO () +f19 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f19_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_95b4b9ea66f61551" f20_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f20@ @@ -360,8 +506,15 @@ foreign import ccall unsafe "hs_bindgen_f81ec562e6b7dc0f" f19 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f20@ -} -foreign import ccall unsafe "hs_bindgen_95b4b9ea66f61551" f20 :: +f20 :: IO () +f20 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f20_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c64dd47543cb7378" f21_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f21@ @@ -371,8 +524,15 @@ foreign import ccall unsafe "hs_bindgen_95b4b9ea66f61551" f20 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f21@ -} -foreign import ccall unsafe "hs_bindgen_c64dd47543cb7378" f21 :: +f21 :: IO () +f21 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f21_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ce27e3f019c9d235" f22_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f22@ @@ -382,8 +542,15 @@ foreign import ccall unsafe "hs_bindgen_c64dd47543cb7378" f21 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f22@ -} -foreign import ccall unsafe "hs_bindgen_ce27e3f019c9d235" f22 :: +f22 :: IO () +f22 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f22_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ae8f854ac4a07381" f23_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f23@ @@ -393,8 +560,15 @@ foreign import ccall unsafe "hs_bindgen_ce27e3f019c9d235" f22 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f23@ -} -foreign import ccall unsafe "hs_bindgen_ae8f854ac4a07381" f23 :: +f23 :: IO () +f23 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f23_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d4585a283ed9fc36" f24_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f24@ @@ -404,8 +578,15 @@ foreign import ccall unsafe "hs_bindgen_ae8f854ac4a07381" f23 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f24@ -} -foreign import ccall unsafe "hs_bindgen_d4585a283ed9fc36" f24 :: +f24 :: IO () +f24 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f24_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f600df85706a5312" f25_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f25@ @@ -415,8 +596,15 @@ foreign import ccall unsafe "hs_bindgen_d4585a283ed9fc36" f24 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f25@ -} -foreign import ccall unsafe "hs_bindgen_f600df85706a5312" f25 :: +f25 :: IO () +f25 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f25_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_92731c80b3281e1c" f26_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f26@ @@ -426,8 +614,15 @@ foreign import ccall unsafe "hs_bindgen_f600df85706a5312" f25 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f26@ -} -foreign import ccall unsafe "hs_bindgen_92731c80b3281e1c" f26 :: +f26 :: IO () +f26 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f26_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_930247d3730559af" f27_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f27@ @@ -437,8 +632,15 @@ foreign import ccall unsafe "hs_bindgen_92731c80b3281e1c" f26 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f27@ -} -foreign import ccall unsafe "hs_bindgen_930247d3730559af" f27 :: +f27 :: IO () +f27 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f27_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2d1ce37b69d8d467" f28_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f28@ @@ -448,8 +650,15 @@ foreign import ccall unsafe "hs_bindgen_930247d3730559af" f27 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f28@ -} -foreign import ccall unsafe "hs_bindgen_2d1ce37b69d8d467" f28 :: +f28 :: IO () +f28 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f28_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3f89a86cfcdf475d" f29_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f29@ @@ -459,5 +668,7 @@ foreign import ccall unsafe "hs_bindgen_2d1ce37b69d8d467" f28 :: __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f29@ -} -foreign import ccall unsafe "hs_bindgen_3f89a86cfcdf475d" f29 :: +f29 :: IO () +f29 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f29_base diff --git a/hs-bindgen/fixtures/attributes/visibility_attributes/th.txt b/hs-bindgen/fixtures/attributes/visibility_attributes/th.txt index fc61a23ed..a76c0d0df 100644 --- a/hs-bindgen/fixtures/attributes/visibility_attributes/th.txt +++ b/hs-bindgen/fixtures/attributes/visibility_attributes/th.txt @@ -540,6 +540,18 @@ -- { -- return &i19; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e64a83c5f7f51679" f0_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f0@ + + __defined at:__ @attributes\/visibility_attributes.h:17:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f0@ +-} +f0 :: IO Unit {-| __C declaration:__ @f0@ __defined at:__ @attributes\/visibility_attributes.h:17:56@ @@ -548,7 +560,19 @@ __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f0@ -} -foreign import ccall safe "hs_bindgen_e64a83c5f7f51679" f0 :: IO Unit +f0 = fromBaseForeignType f0_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8881b0f4ce94e440" f1_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f1@ + + __defined at:__ @attributes\/visibility_attributes.h:18:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f1@ +-} +f1 :: IO Unit {-| __C declaration:__ @f1@ __defined at:__ @attributes\/visibility_attributes.h:18:56@ @@ -557,7 +581,19 @@ foreign import ccall safe "hs_bindgen_e64a83c5f7f51679" f0 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f1@ -} -foreign import ccall safe "hs_bindgen_8881b0f4ce94e440" f1 :: IO Unit +f1 = fromBaseForeignType f1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4ede7f4c96b4d1b5" f2_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f2@ + + __defined at:__ @attributes\/visibility_attributes.h:19:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f2@ +-} +f2 :: IO Unit {-| __C declaration:__ @f2@ __defined at:__ @attributes\/visibility_attributes.h:19:56@ @@ -566,7 +602,10 @@ foreign import ccall safe "hs_bindgen_8881b0f4ce94e440" f1 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f2@ -} -foreign import ccall safe "hs_bindgen_4ede7f4c96b4d1b5" f2 :: IO Unit +f2 = fromBaseForeignType f2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_018f1e15132ff973" f3_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f3@ __defined at:__ @attributes\/visibility_attributes.h:20:56@ @@ -575,7 +614,19 @@ foreign import ccall safe "hs_bindgen_4ede7f4c96b4d1b5" f2 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f3@ -} -foreign import ccall safe "hs_bindgen_018f1e15132ff973" f3 :: IO Unit +f3 :: IO Unit +{-| __C declaration:__ @f3@ + + __defined at:__ @attributes\/visibility_attributes.h:20:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f3@ +-} +f3 = fromBaseForeignType f3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9d93cf33b1a833d1" f4_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f4@ __defined at:__ @attributes\/visibility_attributes.h:21:56@ @@ -584,7 +635,19 @@ foreign import ccall safe "hs_bindgen_018f1e15132ff973" f3 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f4@ -} -foreign import ccall safe "hs_bindgen_9d93cf33b1a833d1" f4 :: IO Unit +f4 :: IO Unit +{-| __C declaration:__ @f4@ + + __defined at:__ @attributes\/visibility_attributes.h:21:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f4@ +-} +f4 = fromBaseForeignType f4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_959298c4e5cb061a" f5_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f5@ __defined at:__ @attributes\/visibility_attributes.h:24:56@ @@ -593,7 +656,19 @@ foreign import ccall safe "hs_bindgen_9d93cf33b1a833d1" f4 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f5@ -} -foreign import ccall safe "hs_bindgen_959298c4e5cb061a" f5 :: IO Unit +f5 :: IO Unit +{-| __C declaration:__ @f5@ + + __defined at:__ @attributes\/visibility_attributes.h:24:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f5@ +-} +f5 = fromBaseForeignType f5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_218297218a4953d6" f6_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f6@ __defined at:__ @attributes\/visibility_attributes.h:25:56@ @@ -602,7 +677,28 @@ foreign import ccall safe "hs_bindgen_959298c4e5cb061a" f5 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f6@ -} -foreign import ccall safe "hs_bindgen_218297218a4953d6" f6 :: IO Unit +f6 :: IO Unit +{-| __C declaration:__ @f6@ + + __defined at:__ @attributes\/visibility_attributes.h:25:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f6@ +-} +f6 = fromBaseForeignType f6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_df320fe3d4683ff9" f7_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f7@ + + __defined at:__ @attributes\/visibility_attributes.h:26:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f7@ +-} +f7 :: IO Unit {-| __C declaration:__ @f7@ __defined at:__ @attributes\/visibility_attributes.h:26:56@ @@ -611,7 +707,19 @@ foreign import ccall safe "hs_bindgen_218297218a4953d6" f6 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f7@ -} -foreign import ccall safe "hs_bindgen_df320fe3d4683ff9" f7 :: IO Unit +f7 = fromBaseForeignType f7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cd613f46d2e06e18" f8_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f8@ + + __defined at:__ @attributes\/visibility_attributes.h:27:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f8@ +-} +f8 :: IO Unit {-| __C declaration:__ @f8@ __defined at:__ @attributes\/visibility_attributes.h:27:56@ @@ -620,7 +728,10 @@ foreign import ccall safe "hs_bindgen_df320fe3d4683ff9" f7 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f8@ -} -foreign import ccall safe "hs_bindgen_cd613f46d2e06e18" f8 :: IO Unit +f8 = fromBaseForeignType f8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_67774b3f22bd7286" f9_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f9@ __defined at:__ @attributes\/visibility_attributes.h:28:56@ @@ -629,7 +740,19 @@ foreign import ccall safe "hs_bindgen_cd613f46d2e06e18" f8 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f9@ -} -foreign import ccall safe "hs_bindgen_67774b3f22bd7286" f9 :: IO Unit +f9 :: IO Unit +{-| __C declaration:__ @f9@ + + __defined at:__ @attributes\/visibility_attributes.h:28:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f9@ +-} +f9 = fromBaseForeignType f9_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dbbd2e0417380ce9" f10_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f10@ __defined at:__ @attributes\/visibility_attributes.h:31:56@ @@ -638,7 +761,19 @@ foreign import ccall safe "hs_bindgen_67774b3f22bd7286" f9 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f10@ -} -foreign import ccall safe "hs_bindgen_dbbd2e0417380ce9" f10 :: IO Unit +f10 :: IO Unit +{-| __C declaration:__ @f10@ + + __defined at:__ @attributes\/visibility_attributes.h:31:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f10@ +-} +f10 = fromBaseForeignType f10_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9d8fadad3f85e1fc" f11_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f11@ __defined at:__ @attributes\/visibility_attributes.h:32:56@ @@ -647,7 +782,28 @@ foreign import ccall safe "hs_bindgen_dbbd2e0417380ce9" f10 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f11@ -} -foreign import ccall safe "hs_bindgen_9d8fadad3f85e1fc" f11 :: IO Unit +f11 :: IO Unit +{-| __C declaration:__ @f11@ + + __defined at:__ @attributes\/visibility_attributes.h:32:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f11@ +-} +f11 = fromBaseForeignType f11_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_558a7ef50878f4b2" f12_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f12@ + + __defined at:__ @attributes\/visibility_attributes.h:33:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f12@ +-} +f12 :: IO Unit {-| __C declaration:__ @f12@ __defined at:__ @attributes\/visibility_attributes.h:33:56@ @@ -656,7 +812,19 @@ foreign import ccall safe "hs_bindgen_9d8fadad3f85e1fc" f11 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f12@ -} -foreign import ccall safe "hs_bindgen_558a7ef50878f4b2" f12 :: IO Unit +f12 = fromBaseForeignType f12_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_30add751959aac79" f13_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f13@ + + __defined at:__ @attributes\/visibility_attributes.h:34:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f13@ +-} +f13 :: IO Unit {-| __C declaration:__ @f13@ __defined at:__ @attributes\/visibility_attributes.h:34:56@ @@ -665,7 +833,19 @@ foreign import ccall safe "hs_bindgen_558a7ef50878f4b2" f12 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f13@ -} -foreign import ccall safe "hs_bindgen_30add751959aac79" f13 :: IO Unit +f13 = fromBaseForeignType f13_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_06b989df2d3622ad" f14_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f14@ + + __defined at:__ @attributes\/visibility_attributes.h:35:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f14@ +-} +f14 :: IO Unit {-| __C declaration:__ @f14@ __defined at:__ @attributes\/visibility_attributes.h:35:56@ @@ -674,7 +854,10 @@ foreign import ccall safe "hs_bindgen_30add751959aac79" f13 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f14@ -} -foreign import ccall safe "hs_bindgen_06b989df2d3622ad" f14 :: IO Unit +f14 = fromBaseForeignType f14_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_11627343b78e6e76" f15_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f15@ __defined at:__ @attributes\/visibility_attributes.h:38:56@ @@ -683,7 +866,19 @@ foreign import ccall safe "hs_bindgen_06b989df2d3622ad" f14 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f15@ -} -foreign import ccall safe "hs_bindgen_11627343b78e6e76" f15 :: IO Unit +f15 :: IO Unit +{-| __C declaration:__ @f15@ + + __defined at:__ @attributes\/visibility_attributes.h:38:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f15@ +-} +f15 = fromBaseForeignType f15_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5d3aa9a924674163" f16_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f16@ __defined at:__ @attributes\/visibility_attributes.h:39:56@ @@ -692,7 +887,19 @@ foreign import ccall safe "hs_bindgen_11627343b78e6e76" f15 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f16@ -} -foreign import ccall safe "hs_bindgen_5d3aa9a924674163" f16 :: IO Unit +f16 :: IO Unit +{-| __C declaration:__ @f16@ + + __defined at:__ @attributes\/visibility_attributes.h:39:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f16@ +-} +f16 = fromBaseForeignType f16_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_65abad67aeb6b955" f17_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f17@ __defined at:__ @attributes\/visibility_attributes.h:40:56@ @@ -701,7 +908,28 @@ foreign import ccall safe "hs_bindgen_5d3aa9a924674163" f16 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f17@ -} -foreign import ccall safe "hs_bindgen_65abad67aeb6b955" f17 :: IO Unit +f17 :: IO Unit +{-| __C declaration:__ @f17@ + + __defined at:__ @attributes\/visibility_attributes.h:40:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f17@ +-} +f17 = fromBaseForeignType f17_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0350778b298751b2" f18_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f18@ + + __defined at:__ @attributes\/visibility_attributes.h:41:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f18@ +-} +f18 :: IO Unit {-| __C declaration:__ @f18@ __defined at:__ @attributes\/visibility_attributes.h:41:56@ @@ -710,7 +938,19 @@ foreign import ccall safe "hs_bindgen_65abad67aeb6b955" f17 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f18@ -} -foreign import ccall safe "hs_bindgen_0350778b298751b2" f18 :: IO Unit +f18 = fromBaseForeignType f18_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aacba18c2fb3dae1" f19_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f19@ + + __defined at:__ @attributes\/visibility_attributes.h:42:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f19@ +-} +f19 :: IO Unit {-| __C declaration:__ @f19@ __defined at:__ @attributes\/visibility_attributes.h:42:56@ @@ -719,7 +959,19 @@ foreign import ccall safe "hs_bindgen_0350778b298751b2" f18 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f19@ -} -foreign import ccall safe "hs_bindgen_aacba18c2fb3dae1" f19 :: IO Unit +f19 = fromBaseForeignType f19_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_023f4d5d2a56d2e9" f20_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f20@ + + __defined at:__ @attributes\/visibility_attributes.h:45:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f20@ +-} +f20 :: IO Unit {-| __C declaration:__ @f20@ __defined at:__ @attributes\/visibility_attributes.h:45:56@ @@ -728,7 +980,10 @@ foreign import ccall safe "hs_bindgen_aacba18c2fb3dae1" f19 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f20@ -} -foreign import ccall safe "hs_bindgen_023f4d5d2a56d2e9" f20 :: IO Unit +f20 = fromBaseForeignType f20_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3a70db9f9e280b85" f21_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f21@ __defined at:__ @attributes\/visibility_attributes.h:46:56@ @@ -737,7 +992,28 @@ foreign import ccall safe "hs_bindgen_023f4d5d2a56d2e9" f20 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f21@ -} -foreign import ccall safe "hs_bindgen_3a70db9f9e280b85" f21 :: IO Unit +f21 :: IO Unit +{-| __C declaration:__ @f21@ + + __defined at:__ @attributes\/visibility_attributes.h:46:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f21@ +-} +f21 = fromBaseForeignType f21_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a4fc9586b7510ea6" f22_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f22@ + + __defined at:__ @attributes\/visibility_attributes.h:47:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f22@ +-} +f22 :: IO Unit {-| __C declaration:__ @f22@ __defined at:__ @attributes\/visibility_attributes.h:47:56@ @@ -746,7 +1022,10 @@ foreign import ccall safe "hs_bindgen_3a70db9f9e280b85" f21 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f22@ -} -foreign import ccall safe "hs_bindgen_a4fc9586b7510ea6" f22 :: IO Unit +f22 = fromBaseForeignType f22_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c25df69a5f23a9b9" f23_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f23@ __defined at:__ @attributes\/visibility_attributes.h:48:56@ @@ -755,7 +1034,28 @@ foreign import ccall safe "hs_bindgen_a4fc9586b7510ea6" f22 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f23@ -} -foreign import ccall safe "hs_bindgen_c25df69a5f23a9b9" f23 :: IO Unit +f23 :: IO Unit +{-| __C declaration:__ @f23@ + + __defined at:__ @attributes\/visibility_attributes.h:48:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f23@ +-} +f23 = fromBaseForeignType f23_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_909c5201154b4617" f24_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f24@ + + __defined at:__ @attributes\/visibility_attributes.h:49:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f24@ +-} +f24 :: IO Unit {-| __C declaration:__ @f24@ __defined at:__ @attributes\/visibility_attributes.h:49:56@ @@ -764,7 +1064,19 @@ foreign import ccall safe "hs_bindgen_c25df69a5f23a9b9" f23 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f24@ -} -foreign import ccall safe "hs_bindgen_909c5201154b4617" f24 :: IO Unit +f24 = fromBaseForeignType f24_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dfbd362260cd0fba" f25_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f25@ + + __defined at:__ @attributes\/visibility_attributes.h:52:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f25@ +-} +f25 :: IO Unit {-| __C declaration:__ @f25@ __defined at:__ @attributes\/visibility_attributes.h:52:56@ @@ -773,7 +1085,19 @@ foreign import ccall safe "hs_bindgen_909c5201154b4617" f24 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f25@ -} -foreign import ccall safe "hs_bindgen_dfbd362260cd0fba" f25 :: IO Unit +f25 = fromBaseForeignType f25_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d9c4d8bc1b7d8a59" f26_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f26@ + + __defined at:__ @attributes\/visibility_attributes.h:53:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f26@ +-} +f26 :: IO Unit {-| __C declaration:__ @f26@ __defined at:__ @attributes\/visibility_attributes.h:53:56@ @@ -782,7 +1106,10 @@ foreign import ccall safe "hs_bindgen_dfbd362260cd0fba" f25 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f26@ -} -foreign import ccall safe "hs_bindgen_d9c4d8bc1b7d8a59" f26 :: IO Unit +f26 = fromBaseForeignType f26_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_71a726a6d6e62f14" f27_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f27@ __defined at:__ @attributes\/visibility_attributes.h:54:56@ @@ -791,7 +1118,28 @@ foreign import ccall safe "hs_bindgen_d9c4d8bc1b7d8a59" f26 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f27@ -} -foreign import ccall safe "hs_bindgen_71a726a6d6e62f14" f27 :: IO Unit +f27 :: IO Unit +{-| __C declaration:__ @f27@ + + __defined at:__ @attributes\/visibility_attributes.h:54:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f27@ +-} +f27 = fromBaseForeignType f27_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_70f35808778a1423" f28_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f28@ + + __defined at:__ @attributes\/visibility_attributes.h:55:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f28@ +-} +f28 :: IO Unit {-| __C declaration:__ @f28@ __defined at:__ @attributes\/visibility_attributes.h:55:56@ @@ -800,7 +1148,10 @@ foreign import ccall safe "hs_bindgen_71a726a6d6e62f14" f27 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f28@ -} -foreign import ccall safe "hs_bindgen_70f35808778a1423" f28 :: IO Unit +f28 = fromBaseForeignType f28_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7ba7293cedb52447" f29_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f29@ __defined at:__ @attributes\/visibility_attributes.h:56:56@ @@ -809,7 +1160,28 @@ foreign import ccall safe "hs_bindgen_70f35808778a1423" f28 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f29@ -} -foreign import ccall safe "hs_bindgen_7ba7293cedb52447" f29 :: IO Unit +f29 :: IO Unit +{-| __C declaration:__ @f29@ + + __defined at:__ @attributes\/visibility_attributes.h:56:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f29@ +-} +f29 = fromBaseForeignType f29_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_df56d82c9186c794" f0_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f0@ + + __defined at:__ @attributes\/visibility_attributes.h:17:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f0@ +-} +f0 :: IO Unit {-| __C declaration:__ @f0@ __defined at:__ @attributes\/visibility_attributes.h:17:56@ @@ -818,7 +1190,19 @@ foreign import ccall safe "hs_bindgen_7ba7293cedb52447" f29 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f0@ -} -foreign import ccall safe "hs_bindgen_df56d82c9186c794" f0 :: IO Unit +f0 = fromBaseForeignType f0_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2e25b1147da3cdee" f1_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f1@ + + __defined at:__ @attributes\/visibility_attributes.h:18:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f1@ +-} +f1 :: IO Unit {-| __C declaration:__ @f1@ __defined at:__ @attributes\/visibility_attributes.h:18:56@ @@ -827,7 +1211,10 @@ foreign import ccall safe "hs_bindgen_df56d82c9186c794" f0 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f1@ -} -foreign import ccall safe "hs_bindgen_2e25b1147da3cdee" f1 :: IO Unit +f1 = fromBaseForeignType f1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c57341dd645988f6" f2_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f2@ __defined at:__ @attributes\/visibility_attributes.h:19:56@ @@ -836,7 +1223,19 @@ foreign import ccall safe "hs_bindgen_2e25b1147da3cdee" f1 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f2@ -} -foreign import ccall safe "hs_bindgen_c57341dd645988f6" f2 :: IO Unit +f2 :: IO Unit +{-| __C declaration:__ @f2@ + + __defined at:__ @attributes\/visibility_attributes.h:19:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f2@ +-} +f2 = fromBaseForeignType f2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5858f33f5b12f541" f3_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f3@ __defined at:__ @attributes\/visibility_attributes.h:20:56@ @@ -845,7 +1244,28 @@ foreign import ccall safe "hs_bindgen_c57341dd645988f6" f2 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f3@ -} -foreign import ccall safe "hs_bindgen_5858f33f5b12f541" f3 :: IO Unit +f3 :: IO Unit +{-| __C declaration:__ @f3@ + + __defined at:__ @attributes\/visibility_attributes.h:20:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f3@ +-} +f3 = fromBaseForeignType f3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d57b75423078a644" f4_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f4@ + + __defined at:__ @attributes\/visibility_attributes.h:21:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f4@ +-} +f4 :: IO Unit {-| __C declaration:__ @f4@ __defined at:__ @attributes\/visibility_attributes.h:21:56@ @@ -854,7 +1274,10 @@ foreign import ccall safe "hs_bindgen_5858f33f5b12f541" f3 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f4@ -} -foreign import ccall safe "hs_bindgen_d57b75423078a644" f4 :: IO Unit +f4 = fromBaseForeignType f4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d7e35ffb8ef15009" f5_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f5@ __defined at:__ @attributes\/visibility_attributes.h:24:56@ @@ -863,7 +1286,28 @@ foreign import ccall safe "hs_bindgen_d57b75423078a644" f4 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f5@ -} -foreign import ccall safe "hs_bindgen_d7e35ffb8ef15009" f5 :: IO Unit +f5 :: IO Unit +{-| __C declaration:__ @f5@ + + __defined at:__ @attributes\/visibility_attributes.h:24:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f5@ +-} +f5 = fromBaseForeignType f5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_de345dceb6694e2e" f6_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f6@ + + __defined at:__ @attributes\/visibility_attributes.h:25:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f6@ +-} +f6 :: IO Unit {-| __C declaration:__ @f6@ __defined at:__ @attributes\/visibility_attributes.h:25:56@ @@ -872,7 +1316,19 @@ foreign import ccall safe "hs_bindgen_d7e35ffb8ef15009" f5 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f6@ -} -foreign import ccall safe "hs_bindgen_de345dceb6694e2e" f6 :: IO Unit +f6 = fromBaseForeignType f6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_df2fd4ea47789bb8" f7_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f7@ + + __defined at:__ @attributes\/visibility_attributes.h:26:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f7@ +-} +f7 :: IO Unit {-| __C declaration:__ @f7@ __defined at:__ @attributes\/visibility_attributes.h:26:56@ @@ -881,7 +1337,19 @@ foreign import ccall safe "hs_bindgen_de345dceb6694e2e" f6 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f7@ -} -foreign import ccall safe "hs_bindgen_df2fd4ea47789bb8" f7 :: IO Unit +f7 = fromBaseForeignType f7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a49e6066d8dd0628" f8_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f8@ + + __defined at:__ @attributes\/visibility_attributes.h:27:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f8@ +-} +f8 :: IO Unit {-| __C declaration:__ @f8@ __defined at:__ @attributes\/visibility_attributes.h:27:56@ @@ -890,7 +1358,10 @@ foreign import ccall safe "hs_bindgen_df2fd4ea47789bb8" f7 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f8@ -} -foreign import ccall safe "hs_bindgen_a49e6066d8dd0628" f8 :: IO Unit +f8 = fromBaseForeignType f8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e94ceb5e10d07a59" f9_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f9@ __defined at:__ @attributes\/visibility_attributes.h:28:56@ @@ -899,7 +1370,28 @@ foreign import ccall safe "hs_bindgen_a49e6066d8dd0628" f8 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f9@ -} -foreign import ccall safe "hs_bindgen_e94ceb5e10d07a59" f9 :: IO Unit +f9 :: IO Unit +{-| __C declaration:__ @f9@ + + __defined at:__ @attributes\/visibility_attributes.h:28:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f9@ +-} +f9 = fromBaseForeignType f9_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d329fc979eb3d29e" f10_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f10@ + + __defined at:__ @attributes\/visibility_attributes.h:31:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f10@ +-} +f10 :: IO Unit {-| __C declaration:__ @f10@ __defined at:__ @attributes\/visibility_attributes.h:31:56@ @@ -908,7 +1400,10 @@ foreign import ccall safe "hs_bindgen_e94ceb5e10d07a59" f9 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f10@ -} -foreign import ccall safe "hs_bindgen_d329fc979eb3d29e" f10 :: IO Unit +f10 = fromBaseForeignType f10_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9f7176bfdf1871cf" f11_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f11@ __defined at:__ @attributes\/visibility_attributes.h:32:56@ @@ -917,7 +1412,28 @@ foreign import ccall safe "hs_bindgen_d329fc979eb3d29e" f10 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f11@ -} -foreign import ccall safe "hs_bindgen_9f7176bfdf1871cf" f11 :: IO Unit +f11 :: IO Unit +{-| __C declaration:__ @f11@ + + __defined at:__ @attributes\/visibility_attributes.h:32:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f11@ +-} +f11 = fromBaseForeignType f11_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d06a71df91d678f1" f12_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f12@ + + __defined at:__ @attributes\/visibility_attributes.h:33:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f12@ +-} +f12 :: IO Unit {-| __C declaration:__ @f12@ __defined at:__ @attributes\/visibility_attributes.h:33:56@ @@ -926,7 +1442,19 @@ foreign import ccall safe "hs_bindgen_9f7176bfdf1871cf" f11 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f12@ -} -foreign import ccall safe "hs_bindgen_d06a71df91d678f1" f12 :: IO Unit +f12 = fromBaseForeignType f12_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_32916e0b4775516d" f13_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f13@ + + __defined at:__ @attributes\/visibility_attributes.h:34:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f13@ +-} +f13 :: IO Unit {-| __C declaration:__ @f13@ __defined at:__ @attributes\/visibility_attributes.h:34:56@ @@ -935,7 +1463,19 @@ foreign import ccall safe "hs_bindgen_d06a71df91d678f1" f12 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f13@ -} -foreign import ccall safe "hs_bindgen_32916e0b4775516d" f13 :: IO Unit +f13 = fromBaseForeignType f13_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_56f26ce5de7906a8" f14_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f14@ + + __defined at:__ @attributes\/visibility_attributes.h:35:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f14@ +-} +f14 :: IO Unit {-| __C declaration:__ @f14@ __defined at:__ @attributes\/visibility_attributes.h:35:56@ @@ -944,7 +1484,10 @@ foreign import ccall safe "hs_bindgen_32916e0b4775516d" f13 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f14@ -} -foreign import ccall safe "hs_bindgen_56f26ce5de7906a8" f14 :: IO Unit +f14 = fromBaseForeignType f14_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fd2972764f48a143" f15_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f15@ __defined at:__ @attributes\/visibility_attributes.h:38:56@ @@ -953,7 +1496,28 @@ foreign import ccall safe "hs_bindgen_56f26ce5de7906a8" f14 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f15@ -} -foreign import ccall safe "hs_bindgen_fd2972764f48a143" f15 :: IO Unit +f15 :: IO Unit +{-| __C declaration:__ @f15@ + + __defined at:__ @attributes\/visibility_attributes.h:38:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f15@ +-} +f15 = fromBaseForeignType f15_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f63a042e539ff8b6" f16_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f16@ + + __defined at:__ @attributes\/visibility_attributes.h:39:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f16@ +-} +f16 :: IO Unit {-| __C declaration:__ @f16@ __defined at:__ @attributes\/visibility_attributes.h:39:56@ @@ -962,16 +1526,40 @@ foreign import ccall safe "hs_bindgen_fd2972764f48a143" f15 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f16@ -} -foreign import ccall safe "hs_bindgen_f63a042e539ff8b6" f16 :: IO Unit -{-| __C declaration:__ @f17@ +f16 = fromBaseForeignType f16_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1ae5adf1961e06f6" f17_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f17@ + + __defined at:__ @attributes\/visibility_attributes.h:40:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f17@ +-} +f17 :: IO Unit +{-| __C declaration:__ @f17@ + + __defined at:__ @attributes\/visibility_attributes.h:40:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f17@ +-} +f17 = fromBaseForeignType f17_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cf7978ab53dc8140" f18_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f18@ - __defined at:__ @attributes\/visibility_attributes.h:40:56@ + __defined at:__ @attributes\/visibility_attributes.h:41:56@ __exported by:__ @attributes\/visibility_attributes.h@ - __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f17@ + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f18@ -} -foreign import ccall safe "hs_bindgen_1ae5adf1961e06f6" f17 :: IO Unit +f18 :: IO Unit {-| __C declaration:__ @f18@ __defined at:__ @attributes\/visibility_attributes.h:41:56@ @@ -980,7 +1568,19 @@ foreign import ccall safe "hs_bindgen_1ae5adf1961e06f6" f17 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f18@ -} -foreign import ccall safe "hs_bindgen_cf7978ab53dc8140" f18 :: IO Unit +f18 = fromBaseForeignType f18_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f81ec562e6b7dc0f" f19_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f19@ + + __defined at:__ @attributes\/visibility_attributes.h:42:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f19@ +-} +f19 :: IO Unit {-| __C declaration:__ @f19@ __defined at:__ @attributes\/visibility_attributes.h:42:56@ @@ -989,7 +1589,19 @@ foreign import ccall safe "hs_bindgen_cf7978ab53dc8140" f18 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f19@ -} -foreign import ccall safe "hs_bindgen_f81ec562e6b7dc0f" f19 :: IO Unit +f19 = fromBaseForeignType f19_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_95b4b9ea66f61551" f20_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f20@ + + __defined at:__ @attributes\/visibility_attributes.h:45:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f20@ +-} +f20 :: IO Unit {-| __C declaration:__ @f20@ __defined at:__ @attributes\/visibility_attributes.h:45:56@ @@ -998,7 +1610,19 @@ foreign import ccall safe "hs_bindgen_f81ec562e6b7dc0f" f19 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f20@ -} -foreign import ccall safe "hs_bindgen_95b4b9ea66f61551" f20 :: IO Unit +f20 = fromBaseForeignType f20_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c64dd47543cb7378" f21_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f21@ + + __defined at:__ @attributes\/visibility_attributes.h:46:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f21@ +-} +f21 :: IO Unit {-| __C declaration:__ @f21@ __defined at:__ @attributes\/visibility_attributes.h:46:56@ @@ -1007,7 +1631,19 @@ foreign import ccall safe "hs_bindgen_95b4b9ea66f61551" f20 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f21@ -} -foreign import ccall safe "hs_bindgen_c64dd47543cb7378" f21 :: IO Unit +f21 = fromBaseForeignType f21_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ce27e3f019c9d235" f22_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f22@ + + __defined at:__ @attributes\/visibility_attributes.h:47:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f22@ +-} +f22 :: IO Unit {-| __C declaration:__ @f22@ __defined at:__ @attributes\/visibility_attributes.h:47:56@ @@ -1016,7 +1652,19 @@ foreign import ccall safe "hs_bindgen_c64dd47543cb7378" f21 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f22@ -} -foreign import ccall safe "hs_bindgen_ce27e3f019c9d235" f22 :: IO Unit +f22 = fromBaseForeignType f22_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ae8f854ac4a07381" f23_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f23@ + + __defined at:__ @attributes\/visibility_attributes.h:48:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f23@ +-} +f23 :: IO Unit {-| __C declaration:__ @f23@ __defined at:__ @attributes\/visibility_attributes.h:48:56@ @@ -1025,7 +1673,19 @@ foreign import ccall safe "hs_bindgen_ce27e3f019c9d235" f22 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f23@ -} -foreign import ccall safe "hs_bindgen_ae8f854ac4a07381" f23 :: IO Unit +f23 = fromBaseForeignType f23_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d4585a283ed9fc36" f24_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f24@ + + __defined at:__ @attributes\/visibility_attributes.h:49:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f24@ +-} +f24 :: IO Unit {-| __C declaration:__ @f24@ __defined at:__ @attributes\/visibility_attributes.h:49:56@ @@ -1034,7 +1694,19 @@ foreign import ccall safe "hs_bindgen_ae8f854ac4a07381" f23 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f24@ -} -foreign import ccall safe "hs_bindgen_d4585a283ed9fc36" f24 :: IO Unit +f24 = fromBaseForeignType f24_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f600df85706a5312" f25_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f25@ + + __defined at:__ @attributes\/visibility_attributes.h:52:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f25@ +-} +f25 :: IO Unit {-| __C declaration:__ @f25@ __defined at:__ @attributes\/visibility_attributes.h:52:56@ @@ -1043,7 +1715,19 @@ foreign import ccall safe "hs_bindgen_d4585a283ed9fc36" f24 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f25@ -} -foreign import ccall safe "hs_bindgen_f600df85706a5312" f25 :: IO Unit +f25 = fromBaseForeignType f25_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_92731c80b3281e1c" f26_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f26@ + + __defined at:__ @attributes\/visibility_attributes.h:53:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f26@ +-} +f26 :: IO Unit {-| __C declaration:__ @f26@ __defined at:__ @attributes\/visibility_attributes.h:53:56@ @@ -1052,7 +1736,10 @@ foreign import ccall safe "hs_bindgen_f600df85706a5312" f25 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f26@ -} -foreign import ccall safe "hs_bindgen_92731c80b3281e1c" f26 :: IO Unit +f26 = fromBaseForeignType f26_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_930247d3730559af" f27_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f27@ __defined at:__ @attributes\/visibility_attributes.h:54:56@ @@ -1061,7 +1748,28 @@ foreign import ccall safe "hs_bindgen_92731c80b3281e1c" f26 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f27@ -} -foreign import ccall safe "hs_bindgen_930247d3730559af" f27 :: IO Unit +f27 :: IO Unit +{-| __C declaration:__ @f27@ + + __defined at:__ @attributes\/visibility_attributes.h:54:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f27@ +-} +f27 = fromBaseForeignType f27_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2d1ce37b69d8d467" f28_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f28@ + + __defined at:__ @attributes\/visibility_attributes.h:55:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f28@ +-} +f28 :: IO Unit {-| __C declaration:__ @f28@ __defined at:__ @attributes\/visibility_attributes.h:55:56@ @@ -1070,7 +1778,19 @@ foreign import ccall safe "hs_bindgen_930247d3730559af" f27 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f28@ -} -foreign import ccall safe "hs_bindgen_2d1ce37b69d8d467" f28 :: IO Unit +f28 = fromBaseForeignType f28_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3f89a86cfcdf475d" f29_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f29@ + + __defined at:__ @attributes\/visibility_attributes.h:56:56@ + + __exported by:__ @attributes\/visibility_attributes.h@ + + __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f29@ +-} +f29 :: IO Unit {-| __C declaration:__ @f29@ __defined at:__ @attributes\/visibility_attributes.h:56:56@ @@ -1079,10 +1799,16 @@ foreign import ccall safe "hs_bindgen_2d1ce37b69d8d467" f28 :: IO Unit __unique:__ @test_attributesvisibility_attribut_Example_Unsafe_f29@ -} -foreign import ccall safe "hs_bindgen_3f89a86cfcdf475d" f29 :: IO Unit +f29 = fromBaseForeignType f29_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4fa50edab5785792" hs_bindgen_4fa50edab5785792_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f0_ptr@ +-} +hs_bindgen_4fa50edab5785792 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f0_ptr@ -} -foreign import ccall safe "hs_bindgen_4fa50edab5785792" hs_bindgen_4fa50edab5785792 :: IO (FunPtr (IO Unit)) +hs_bindgen_4fa50edab5785792 = fromBaseForeignType hs_bindgen_4fa50edab5785792_base {-# NOINLINE f0_ptr #-} {-| __C declaration:__ @f0@ @@ -1098,9 +1824,15 @@ f0_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f0_ptr = unsafePerformIO hs_bindgen_4fa50edab5785792 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c13821592f55652c" hs_bindgen_c13821592f55652c_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f1_ptr@ +-} +hs_bindgen_c13821592f55652c :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f1_ptr@ -} -foreign import ccall safe "hs_bindgen_c13821592f55652c" hs_bindgen_c13821592f55652c :: IO (FunPtr (IO Unit)) +hs_bindgen_c13821592f55652c = fromBaseForeignType hs_bindgen_c13821592f55652c_base {-# NOINLINE f1_ptr #-} {-| __C declaration:__ @f1@ @@ -1116,9 +1848,15 @@ f1_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f1_ptr = unsafePerformIO hs_bindgen_c13821592f55652c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eeb8c07b1c7d4892" hs_bindgen_eeb8c07b1c7d4892_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f2_ptr@ +-} +hs_bindgen_eeb8c07b1c7d4892 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f2_ptr@ -} -foreign import ccall safe "hs_bindgen_eeb8c07b1c7d4892" hs_bindgen_eeb8c07b1c7d4892 :: IO (FunPtr (IO Unit)) +hs_bindgen_eeb8c07b1c7d4892 = fromBaseForeignType hs_bindgen_eeb8c07b1c7d4892_base {-# NOINLINE f2_ptr #-} {-| __C declaration:__ @f2@ @@ -1134,9 +1872,15 @@ f2_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f2_ptr = unsafePerformIO hs_bindgen_eeb8c07b1c7d4892 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_22da6befd7cfebfe" hs_bindgen_22da6befd7cfebfe_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f3_ptr@ -} -foreign import ccall safe "hs_bindgen_22da6befd7cfebfe" hs_bindgen_22da6befd7cfebfe :: IO (FunPtr (IO Unit)) +hs_bindgen_22da6befd7cfebfe :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f3_ptr@ +-} +hs_bindgen_22da6befd7cfebfe = fromBaseForeignType hs_bindgen_22da6befd7cfebfe_base {-# NOINLINE f3_ptr #-} {-| __C declaration:__ @f3@ @@ -1152,9 +1896,15 @@ f3_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f3_ptr = unsafePerformIO hs_bindgen_22da6befd7cfebfe +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_50c8df797d6f5c39" hs_bindgen_50c8df797d6f5c39_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f4_ptr@ +-} +hs_bindgen_50c8df797d6f5c39 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f4_ptr@ -} -foreign import ccall safe "hs_bindgen_50c8df797d6f5c39" hs_bindgen_50c8df797d6f5c39 :: IO (FunPtr (IO Unit)) +hs_bindgen_50c8df797d6f5c39 = fromBaseForeignType hs_bindgen_50c8df797d6f5c39_base {-# NOINLINE f4_ptr #-} {-| __C declaration:__ @f4@ @@ -1170,9 +1920,15 @@ f4_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f4_ptr = unsafePerformIO hs_bindgen_50c8df797d6f5c39 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_495ed8345db40ba2" hs_bindgen_495ed8345db40ba2_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f5_ptr@ +-} +hs_bindgen_495ed8345db40ba2 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f5_ptr@ -} -foreign import ccall safe "hs_bindgen_495ed8345db40ba2" hs_bindgen_495ed8345db40ba2 :: IO (FunPtr (IO Unit)) +hs_bindgen_495ed8345db40ba2 = fromBaseForeignType hs_bindgen_495ed8345db40ba2_base {-# NOINLINE f5_ptr #-} {-| __C declaration:__ @f5@ @@ -1188,9 +1944,15 @@ f5_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f5_ptr = unsafePerformIO hs_bindgen_495ed8345db40ba2 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2443b169338ac3f7" hs_bindgen_2443b169338ac3f7_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f6_ptr@ +-} +hs_bindgen_2443b169338ac3f7 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f6_ptr@ -} -foreign import ccall safe "hs_bindgen_2443b169338ac3f7" hs_bindgen_2443b169338ac3f7 :: IO (FunPtr (IO Unit)) +hs_bindgen_2443b169338ac3f7 = fromBaseForeignType hs_bindgen_2443b169338ac3f7_base {-# NOINLINE f6_ptr #-} {-| __C declaration:__ @f6@ @@ -1206,9 +1968,15 @@ f6_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f6_ptr = unsafePerformIO hs_bindgen_2443b169338ac3f7 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_949fd6e2edb95316" hs_bindgen_949fd6e2edb95316_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f7_ptr@ -} -foreign import ccall safe "hs_bindgen_949fd6e2edb95316" hs_bindgen_949fd6e2edb95316 :: IO (FunPtr (IO Unit)) +hs_bindgen_949fd6e2edb95316 :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f7_ptr@ +-} +hs_bindgen_949fd6e2edb95316 = fromBaseForeignType hs_bindgen_949fd6e2edb95316_base {-# NOINLINE f7_ptr #-} {-| __C declaration:__ @f7@ @@ -1224,9 +1992,15 @@ f7_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f7_ptr = unsafePerformIO hs_bindgen_949fd6e2edb95316 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f474c8449f3cc4f7" hs_bindgen_f474c8449f3cc4f7_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f8_ptr@ +-} +hs_bindgen_f474c8449f3cc4f7 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f8_ptr@ -} -foreign import ccall safe "hs_bindgen_f474c8449f3cc4f7" hs_bindgen_f474c8449f3cc4f7 :: IO (FunPtr (IO Unit)) +hs_bindgen_f474c8449f3cc4f7 = fromBaseForeignType hs_bindgen_f474c8449f3cc4f7_base {-# NOINLINE f8_ptr #-} {-| __C declaration:__ @f8@ @@ -1242,9 +2016,15 @@ f8_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f8_ptr = unsafePerformIO hs_bindgen_f474c8449f3cc4f7 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3646a569205d32fd" hs_bindgen_3646a569205d32fd_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f9_ptr@ +-} +hs_bindgen_3646a569205d32fd :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f9_ptr@ -} -foreign import ccall safe "hs_bindgen_3646a569205d32fd" hs_bindgen_3646a569205d32fd :: IO (FunPtr (IO Unit)) +hs_bindgen_3646a569205d32fd = fromBaseForeignType hs_bindgen_3646a569205d32fd_base {-# NOINLINE f9_ptr #-} {-| __C declaration:__ @f9@ @@ -1260,9 +2040,15 @@ f9_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f9_ptr = unsafePerformIO hs_bindgen_3646a569205d32fd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3538a19bdbcce7dd" hs_bindgen_3538a19bdbcce7dd_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f10_ptr@ +-} +hs_bindgen_3538a19bdbcce7dd :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f10_ptr@ -} -foreign import ccall safe "hs_bindgen_3538a19bdbcce7dd" hs_bindgen_3538a19bdbcce7dd :: IO (FunPtr (IO Unit)) +hs_bindgen_3538a19bdbcce7dd = fromBaseForeignType hs_bindgen_3538a19bdbcce7dd_base {-# NOINLINE f10_ptr #-} {-| __C declaration:__ @f10@ @@ -1278,9 +2064,15 @@ f10_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f10_ptr = unsafePerformIO hs_bindgen_3538a19bdbcce7dd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_212757456c565a4f" hs_bindgen_212757456c565a4f_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f11_ptr@ -} -foreign import ccall safe "hs_bindgen_212757456c565a4f" hs_bindgen_212757456c565a4f :: IO (FunPtr (IO Unit)) +hs_bindgen_212757456c565a4f :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f11_ptr@ +-} +hs_bindgen_212757456c565a4f = fromBaseForeignType hs_bindgen_212757456c565a4f_base {-# NOINLINE f11_ptr #-} {-| __C declaration:__ @f11@ @@ -1296,9 +2088,15 @@ f11_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f11_ptr = unsafePerformIO hs_bindgen_212757456c565a4f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d1984175b52d2a8a" hs_bindgen_d1984175b52d2a8a_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f12_ptr@ +-} +hs_bindgen_d1984175b52d2a8a :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f12_ptr@ -} -foreign import ccall safe "hs_bindgen_d1984175b52d2a8a" hs_bindgen_d1984175b52d2a8a :: IO (FunPtr (IO Unit)) +hs_bindgen_d1984175b52d2a8a = fromBaseForeignType hs_bindgen_d1984175b52d2a8a_base {-# NOINLINE f12_ptr #-} {-| __C declaration:__ @f12@ @@ -1314,9 +2112,15 @@ f12_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f12_ptr = unsafePerformIO hs_bindgen_d1984175b52d2a8a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_318302468a1f1e5b" hs_bindgen_318302468a1f1e5b_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f13_ptr@ +-} +hs_bindgen_318302468a1f1e5b :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f13_ptr@ -} -foreign import ccall safe "hs_bindgen_318302468a1f1e5b" hs_bindgen_318302468a1f1e5b :: IO (FunPtr (IO Unit)) +hs_bindgen_318302468a1f1e5b = fromBaseForeignType hs_bindgen_318302468a1f1e5b_base {-# NOINLINE f13_ptr #-} {-| __C declaration:__ @f13@ @@ -1332,9 +2136,15 @@ f13_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f13_ptr = unsafePerformIO hs_bindgen_318302468a1f1e5b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ad80c7d6dbd5cae9" hs_bindgen_ad80c7d6dbd5cae9_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f14_ptr@ +-} +hs_bindgen_ad80c7d6dbd5cae9 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f14_ptr@ -} -foreign import ccall safe "hs_bindgen_ad80c7d6dbd5cae9" hs_bindgen_ad80c7d6dbd5cae9 :: IO (FunPtr (IO Unit)) +hs_bindgen_ad80c7d6dbd5cae9 = fromBaseForeignType hs_bindgen_ad80c7d6dbd5cae9_base {-# NOINLINE f14_ptr #-} {-| __C declaration:__ @f14@ @@ -1350,9 +2160,15 @@ f14_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f14_ptr = unsafePerformIO hs_bindgen_ad80c7d6dbd5cae9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4cfe90744e725641" hs_bindgen_4cfe90744e725641_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f15_ptr@ -} -foreign import ccall safe "hs_bindgen_4cfe90744e725641" hs_bindgen_4cfe90744e725641 :: IO (FunPtr (IO Unit)) +hs_bindgen_4cfe90744e725641 :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f15_ptr@ +-} +hs_bindgen_4cfe90744e725641 = fromBaseForeignType hs_bindgen_4cfe90744e725641_base {-# NOINLINE f15_ptr #-} {-| __C declaration:__ @f15@ @@ -1368,9 +2184,15 @@ f15_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f15_ptr = unsafePerformIO hs_bindgen_4cfe90744e725641 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6d14737fe874b3cb" hs_bindgen_6d14737fe874b3cb_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f16_ptr@ +-} +hs_bindgen_6d14737fe874b3cb :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f16_ptr@ -} -foreign import ccall safe "hs_bindgen_6d14737fe874b3cb" hs_bindgen_6d14737fe874b3cb :: IO (FunPtr (IO Unit)) +hs_bindgen_6d14737fe874b3cb = fromBaseForeignType hs_bindgen_6d14737fe874b3cb_base {-# NOINLINE f16_ptr #-} {-| __C declaration:__ @f16@ @@ -1386,9 +2208,15 @@ f16_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f16_ptr = unsafePerformIO hs_bindgen_6d14737fe874b3cb +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_09e8fbff66923029" hs_bindgen_09e8fbff66923029_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f17_ptr@ +-} +hs_bindgen_09e8fbff66923029 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f17_ptr@ -} -foreign import ccall safe "hs_bindgen_09e8fbff66923029" hs_bindgen_09e8fbff66923029 :: IO (FunPtr (IO Unit)) +hs_bindgen_09e8fbff66923029 = fromBaseForeignType hs_bindgen_09e8fbff66923029_base {-# NOINLINE f17_ptr #-} {-| __C declaration:__ @f17@ @@ -1404,9 +2232,15 @@ f17_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f17_ptr = unsafePerformIO hs_bindgen_09e8fbff66923029 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_42a26b5e01e5cd71" hs_bindgen_42a26b5e01e5cd71_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f18_ptr@ +-} +hs_bindgen_42a26b5e01e5cd71 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f18_ptr@ -} -foreign import ccall safe "hs_bindgen_42a26b5e01e5cd71" hs_bindgen_42a26b5e01e5cd71 :: IO (FunPtr (IO Unit)) +hs_bindgen_42a26b5e01e5cd71 = fromBaseForeignType hs_bindgen_42a26b5e01e5cd71_base {-# NOINLINE f18_ptr #-} {-| __C declaration:__ @f18@ @@ -1422,9 +2256,15 @@ f18_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f18_ptr = unsafePerformIO hs_bindgen_42a26b5e01e5cd71 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5176a5601da0207c" hs_bindgen_5176a5601da0207c_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f19_ptr@ -} -foreign import ccall safe "hs_bindgen_5176a5601da0207c" hs_bindgen_5176a5601da0207c :: IO (FunPtr (IO Unit)) +hs_bindgen_5176a5601da0207c :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f19_ptr@ +-} +hs_bindgen_5176a5601da0207c = fromBaseForeignType hs_bindgen_5176a5601da0207c_base {-# NOINLINE f19_ptr #-} {-| __C declaration:__ @f19@ @@ -1440,9 +2280,15 @@ f19_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f19_ptr = unsafePerformIO hs_bindgen_5176a5601da0207c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4eaefbdc60946d59" hs_bindgen_4eaefbdc60946d59_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f20_ptr@ +-} +hs_bindgen_4eaefbdc60946d59 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f20_ptr@ -} -foreign import ccall safe "hs_bindgen_4eaefbdc60946d59" hs_bindgen_4eaefbdc60946d59 :: IO (FunPtr (IO Unit)) +hs_bindgen_4eaefbdc60946d59 = fromBaseForeignType hs_bindgen_4eaefbdc60946d59_base {-# NOINLINE f20_ptr #-} {-| __C declaration:__ @f20@ @@ -1458,9 +2304,15 @@ f20_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f20_ptr = unsafePerformIO hs_bindgen_4eaefbdc60946d59 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_41dfc77185a5f202" hs_bindgen_41dfc77185a5f202_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f21_ptr@ +-} +hs_bindgen_41dfc77185a5f202 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f21_ptr@ -} -foreign import ccall safe "hs_bindgen_41dfc77185a5f202" hs_bindgen_41dfc77185a5f202 :: IO (FunPtr (IO Unit)) +hs_bindgen_41dfc77185a5f202 = fromBaseForeignType hs_bindgen_41dfc77185a5f202_base {-# NOINLINE f21_ptr #-} {-| __C declaration:__ @f21@ @@ -1476,9 +2328,15 @@ f21_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f21_ptr = unsafePerformIO hs_bindgen_41dfc77185a5f202 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a5c1f65da28b559c" hs_bindgen_a5c1f65da28b559c_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f22_ptr@ +-} +hs_bindgen_a5c1f65da28b559c :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f22_ptr@ -} -foreign import ccall safe "hs_bindgen_a5c1f65da28b559c" hs_bindgen_a5c1f65da28b559c :: IO (FunPtr (IO Unit)) +hs_bindgen_a5c1f65da28b559c = fromBaseForeignType hs_bindgen_a5c1f65da28b559c_base {-# NOINLINE f22_ptr #-} {-| __C declaration:__ @f22@ @@ -1494,9 +2352,15 @@ f22_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f22_ptr = unsafePerformIO hs_bindgen_a5c1f65da28b559c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6ea6382845ca7a26" hs_bindgen_6ea6382845ca7a26_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f23_ptr@ -} -foreign import ccall safe "hs_bindgen_6ea6382845ca7a26" hs_bindgen_6ea6382845ca7a26 :: IO (FunPtr (IO Unit)) +hs_bindgen_6ea6382845ca7a26 :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f23_ptr@ +-} +hs_bindgen_6ea6382845ca7a26 = fromBaseForeignType hs_bindgen_6ea6382845ca7a26_base {-# NOINLINE f23_ptr #-} {-| __C declaration:__ @f23@ @@ -1512,9 +2376,15 @@ f23_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f23_ptr = unsafePerformIO hs_bindgen_6ea6382845ca7a26 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8f9343a5bdbbe418" hs_bindgen_8f9343a5bdbbe418_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f24_ptr@ +-} +hs_bindgen_8f9343a5bdbbe418 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f24_ptr@ -} -foreign import ccall safe "hs_bindgen_8f9343a5bdbbe418" hs_bindgen_8f9343a5bdbbe418 :: IO (FunPtr (IO Unit)) +hs_bindgen_8f9343a5bdbbe418 = fromBaseForeignType hs_bindgen_8f9343a5bdbbe418_base {-# NOINLINE f24_ptr #-} {-| __C declaration:__ @f24@ @@ -1530,9 +2400,15 @@ f24_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f24_ptr = unsafePerformIO hs_bindgen_8f9343a5bdbbe418 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8185701609035828" hs_bindgen_8185701609035828_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f25_ptr@ +-} +hs_bindgen_8185701609035828 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f25_ptr@ -} -foreign import ccall safe "hs_bindgen_8185701609035828" hs_bindgen_8185701609035828 :: IO (FunPtr (IO Unit)) +hs_bindgen_8185701609035828 = fromBaseForeignType hs_bindgen_8185701609035828_base {-# NOINLINE f25_ptr #-} {-| __C declaration:__ @f25@ @@ -1548,9 +2424,15 @@ f25_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f25_ptr = unsafePerformIO hs_bindgen_8185701609035828 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cba990b34ea47f08" hs_bindgen_cba990b34ea47f08_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f26_ptr@ +-} +hs_bindgen_cba990b34ea47f08 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f26_ptr@ -} -foreign import ccall safe "hs_bindgen_cba990b34ea47f08" hs_bindgen_cba990b34ea47f08 :: IO (FunPtr (IO Unit)) +hs_bindgen_cba990b34ea47f08 = fromBaseForeignType hs_bindgen_cba990b34ea47f08_base {-# NOINLINE f26_ptr #-} {-| __C declaration:__ @f26@ @@ -1566,9 +2448,15 @@ f26_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f26_ptr = unsafePerformIO hs_bindgen_cba990b34ea47f08 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d20da035780e1286" hs_bindgen_d20da035780e1286_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f27_ptr@ -} -foreign import ccall safe "hs_bindgen_d20da035780e1286" hs_bindgen_d20da035780e1286 :: IO (FunPtr (IO Unit)) +hs_bindgen_d20da035780e1286 :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f27_ptr@ +-} +hs_bindgen_d20da035780e1286 = fromBaseForeignType hs_bindgen_d20da035780e1286_base {-# NOINLINE f27_ptr #-} {-| __C declaration:__ @f27@ @@ -1584,9 +2472,15 @@ f27_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f27_ptr = unsafePerformIO hs_bindgen_d20da035780e1286 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_53755375b7f63b0d" hs_bindgen_53755375b7f63b0d_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f28_ptr@ +-} +hs_bindgen_53755375b7f63b0d :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f28_ptr@ -} -foreign import ccall safe "hs_bindgen_53755375b7f63b0d" hs_bindgen_53755375b7f63b0d :: IO (FunPtr (IO Unit)) +hs_bindgen_53755375b7f63b0d = fromBaseForeignType hs_bindgen_53755375b7f63b0d_base {-# NOINLINE f28_ptr #-} {-| __C declaration:__ @f28@ @@ -1602,9 +2496,15 @@ f28_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f28_ptr = unsafePerformIO hs_bindgen_53755375b7f63b0d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cba78220552029e8" hs_bindgen_cba78220552029e8_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_f29_ptr@ +-} +hs_bindgen_cba78220552029e8 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_f29_ptr@ -} -foreign import ccall safe "hs_bindgen_cba78220552029e8" hs_bindgen_cba78220552029e8 :: IO (FunPtr (IO Unit)) +hs_bindgen_cba78220552029e8 = fromBaseForeignType hs_bindgen_cba78220552029e8_base {-# NOINLINE f29_ptr #-} {-| __C declaration:__ @f29@ @@ -1620,9 +2520,15 @@ f29_ptr :: FunPtr (IO Unit) __exported by:__ @attributes\/visibility_attributes.h@ -} f29_ptr = unsafePerformIO hs_bindgen_cba78220552029e8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_882dcb40c6ad1461" hs_bindgen_882dcb40c6ad1461_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i0_ptr@ +-} +hs_bindgen_882dcb40c6ad1461 :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i0_ptr@ -} -foreign import ccall safe "hs_bindgen_882dcb40c6ad1461" hs_bindgen_882dcb40c6ad1461 :: IO (Ptr CInt) +hs_bindgen_882dcb40c6ad1461 = fromBaseForeignType hs_bindgen_882dcb40c6ad1461_base {-# NOINLINE i0_ptr #-} {-| __C declaration:__ @i0@ @@ -1638,9 +2544,15 @@ i0_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i0_ptr = unsafePerformIO hs_bindgen_882dcb40c6ad1461 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_67e8ccdb1d25e3ae" hs_bindgen_67e8ccdb1d25e3ae_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i1_ptr@ -} -foreign import ccall safe "hs_bindgen_67e8ccdb1d25e3ae" hs_bindgen_67e8ccdb1d25e3ae :: IO (Ptr CInt) +hs_bindgen_67e8ccdb1d25e3ae :: IO (Ptr CInt) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i1_ptr@ +-} +hs_bindgen_67e8ccdb1d25e3ae = fromBaseForeignType hs_bindgen_67e8ccdb1d25e3ae_base {-# NOINLINE i1_ptr #-} {-| __C declaration:__ @i1@ @@ -1656,9 +2568,15 @@ i1_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i1_ptr = unsafePerformIO hs_bindgen_67e8ccdb1d25e3ae +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1ce9eb133565b90a" hs_bindgen_1ce9eb133565b90a_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i2_ptr@ +-} +hs_bindgen_1ce9eb133565b90a :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i2_ptr@ -} -foreign import ccall safe "hs_bindgen_1ce9eb133565b90a" hs_bindgen_1ce9eb133565b90a :: IO (Ptr CInt) +hs_bindgen_1ce9eb133565b90a = fromBaseForeignType hs_bindgen_1ce9eb133565b90a_base {-# NOINLINE i2_ptr #-} {-| __C declaration:__ @i2@ @@ -1674,9 +2592,15 @@ i2_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i2_ptr = unsafePerformIO hs_bindgen_1ce9eb133565b90a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_00fce981bcb56c1a" hs_bindgen_00fce981bcb56c1a_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i3_ptr@ +-} +hs_bindgen_00fce981bcb56c1a :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i3_ptr@ -} -foreign import ccall safe "hs_bindgen_00fce981bcb56c1a" hs_bindgen_00fce981bcb56c1a :: IO (Ptr CInt) +hs_bindgen_00fce981bcb56c1a = fromBaseForeignType hs_bindgen_00fce981bcb56c1a_base {-# NOINLINE i3_ptr #-} {-| __C declaration:__ @i3@ @@ -1692,9 +2616,15 @@ i3_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i3_ptr = unsafePerformIO hs_bindgen_00fce981bcb56c1a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c4b37069d8e025e5" hs_bindgen_c4b37069d8e025e5_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i4_ptr@ +-} +hs_bindgen_c4b37069d8e025e5 :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i4_ptr@ -} -foreign import ccall safe "hs_bindgen_c4b37069d8e025e5" hs_bindgen_c4b37069d8e025e5 :: IO (Ptr CInt) +hs_bindgen_c4b37069d8e025e5 = fromBaseForeignType hs_bindgen_c4b37069d8e025e5_base {-# NOINLINE i4_ptr #-} {-| __C declaration:__ @i4@ @@ -1710,9 +2640,15 @@ i4_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i4_ptr = unsafePerformIO hs_bindgen_c4b37069d8e025e5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bd0f182728abf16f" hs_bindgen_bd0f182728abf16f_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i5_ptr@ -} -foreign import ccall safe "hs_bindgen_bd0f182728abf16f" hs_bindgen_bd0f182728abf16f :: IO (Ptr CInt) +hs_bindgen_bd0f182728abf16f :: IO (Ptr CInt) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i5_ptr@ +-} +hs_bindgen_bd0f182728abf16f = fromBaseForeignType hs_bindgen_bd0f182728abf16f_base {-# NOINLINE i5_ptr #-} {-| __C declaration:__ @i5@ @@ -1728,9 +2664,15 @@ i5_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i5_ptr = unsafePerformIO hs_bindgen_bd0f182728abf16f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c53b7cfddc89a6b9" hs_bindgen_c53b7cfddc89a6b9_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i6_ptr@ +-} +hs_bindgen_c53b7cfddc89a6b9 :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i6_ptr@ -} -foreign import ccall safe "hs_bindgen_c53b7cfddc89a6b9" hs_bindgen_c53b7cfddc89a6b9 :: IO (Ptr CInt) +hs_bindgen_c53b7cfddc89a6b9 = fromBaseForeignType hs_bindgen_c53b7cfddc89a6b9_base {-# NOINLINE i6_ptr #-} {-| __C declaration:__ @i6@ @@ -1746,9 +2688,15 @@ i6_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i6_ptr = unsafePerformIO hs_bindgen_c53b7cfddc89a6b9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_72edacaf16ab0c81" hs_bindgen_72edacaf16ab0c81_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i7_ptr@ +-} +hs_bindgen_72edacaf16ab0c81 :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i7_ptr@ -} -foreign import ccall safe "hs_bindgen_72edacaf16ab0c81" hs_bindgen_72edacaf16ab0c81 :: IO (Ptr CInt) +hs_bindgen_72edacaf16ab0c81 = fromBaseForeignType hs_bindgen_72edacaf16ab0c81_base {-# NOINLINE i7_ptr #-} {-| __C declaration:__ @i7@ @@ -1764,9 +2712,15 @@ i7_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i7_ptr = unsafePerformIO hs_bindgen_72edacaf16ab0c81 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1b48c1380972701f" hs_bindgen_1b48c1380972701f_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i8_ptr@ +-} +hs_bindgen_1b48c1380972701f :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i8_ptr@ -} -foreign import ccall safe "hs_bindgen_1b48c1380972701f" hs_bindgen_1b48c1380972701f :: IO (Ptr CInt) +hs_bindgen_1b48c1380972701f = fromBaseForeignType hs_bindgen_1b48c1380972701f_base {-# NOINLINE i8_ptr #-} {-| __C declaration:__ @i8@ @@ -1782,9 +2736,15 @@ i8_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i8_ptr = unsafePerformIO hs_bindgen_1b48c1380972701f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_63a2d96d25b60025" hs_bindgen_63a2d96d25b60025_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i9_ptr@ -} -foreign import ccall safe "hs_bindgen_63a2d96d25b60025" hs_bindgen_63a2d96d25b60025 :: IO (Ptr CInt) +hs_bindgen_63a2d96d25b60025 :: IO (Ptr CInt) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i9_ptr@ +-} +hs_bindgen_63a2d96d25b60025 = fromBaseForeignType hs_bindgen_63a2d96d25b60025_base {-# NOINLINE i9_ptr #-} {-| __C declaration:__ @i9@ @@ -1800,9 +2760,15 @@ i9_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i9_ptr = unsafePerformIO hs_bindgen_63a2d96d25b60025 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_181bf3398f5fd2d3" hs_bindgen_181bf3398f5fd2d3_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i10_ptr@ +-} +hs_bindgen_181bf3398f5fd2d3 :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i10_ptr@ -} -foreign import ccall safe "hs_bindgen_181bf3398f5fd2d3" hs_bindgen_181bf3398f5fd2d3 :: IO (Ptr CInt) +hs_bindgen_181bf3398f5fd2d3 = fromBaseForeignType hs_bindgen_181bf3398f5fd2d3_base {-# NOINLINE i10_ptr #-} {-| __C declaration:__ @i10@ @@ -1818,9 +2784,15 @@ i10_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i10_ptr = unsafePerformIO hs_bindgen_181bf3398f5fd2d3 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_46ba7aba6f2491ca" hs_bindgen_46ba7aba6f2491ca_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i11_ptr@ +-} +hs_bindgen_46ba7aba6f2491ca :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i11_ptr@ -} -foreign import ccall safe "hs_bindgen_46ba7aba6f2491ca" hs_bindgen_46ba7aba6f2491ca :: IO (Ptr CInt) +hs_bindgen_46ba7aba6f2491ca = fromBaseForeignType hs_bindgen_46ba7aba6f2491ca_base {-# NOINLINE i11_ptr #-} {-| __C declaration:__ @i11@ @@ -1836,9 +2808,15 @@ i11_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i11_ptr = unsafePerformIO hs_bindgen_46ba7aba6f2491ca +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d9e0a613cbcc9f3e" hs_bindgen_d9e0a613cbcc9f3e_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i12_ptr@ +-} +hs_bindgen_d9e0a613cbcc9f3e :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i12_ptr@ -} -foreign import ccall safe "hs_bindgen_d9e0a613cbcc9f3e" hs_bindgen_d9e0a613cbcc9f3e :: IO (Ptr CInt) +hs_bindgen_d9e0a613cbcc9f3e = fromBaseForeignType hs_bindgen_d9e0a613cbcc9f3e_base {-# NOINLINE i12_ptr #-} {-| __C declaration:__ @i12@ @@ -1854,9 +2832,15 @@ i12_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i12_ptr = unsafePerformIO hs_bindgen_d9e0a613cbcc9f3e +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d02e91d8b8f37508" hs_bindgen_d02e91d8b8f37508_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i13_ptr@ -} -foreign import ccall safe "hs_bindgen_d02e91d8b8f37508" hs_bindgen_d02e91d8b8f37508 :: IO (Ptr CInt) +hs_bindgen_d02e91d8b8f37508 :: IO (Ptr CInt) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i13_ptr@ +-} +hs_bindgen_d02e91d8b8f37508 = fromBaseForeignType hs_bindgen_d02e91d8b8f37508_base {-# NOINLINE i13_ptr #-} {-| __C declaration:__ @i13@ @@ -1872,9 +2856,15 @@ i13_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i13_ptr = unsafePerformIO hs_bindgen_d02e91d8b8f37508 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fc03a1c74eda2944" hs_bindgen_fc03a1c74eda2944_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i14_ptr@ +-} +hs_bindgen_fc03a1c74eda2944 :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i14_ptr@ -} -foreign import ccall safe "hs_bindgen_fc03a1c74eda2944" hs_bindgen_fc03a1c74eda2944 :: IO (Ptr CInt) +hs_bindgen_fc03a1c74eda2944 = fromBaseForeignType hs_bindgen_fc03a1c74eda2944_base {-# NOINLINE i14_ptr #-} {-| __C declaration:__ @i14@ @@ -1890,9 +2880,15 @@ i14_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i14_ptr = unsafePerformIO hs_bindgen_fc03a1c74eda2944 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1d303eaadfd446c8" hs_bindgen_1d303eaadfd446c8_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i15_ptr@ +-} +hs_bindgen_1d303eaadfd446c8 :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i15_ptr@ -} -foreign import ccall safe "hs_bindgen_1d303eaadfd446c8" hs_bindgen_1d303eaadfd446c8 :: IO (Ptr CInt) +hs_bindgen_1d303eaadfd446c8 = fromBaseForeignType hs_bindgen_1d303eaadfd446c8_base {-# NOINLINE i15_ptr #-} {-| __C declaration:__ @i15@ @@ -1908,9 +2904,15 @@ i15_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i15_ptr = unsafePerformIO hs_bindgen_1d303eaadfd446c8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_625545a81d12a4a3" hs_bindgen_625545a81d12a4a3_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i16_ptr@ +-} +hs_bindgen_625545a81d12a4a3 :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i16_ptr@ -} -foreign import ccall safe "hs_bindgen_625545a81d12a4a3" hs_bindgen_625545a81d12a4a3 :: IO (Ptr CInt) +hs_bindgen_625545a81d12a4a3 = fromBaseForeignType hs_bindgen_625545a81d12a4a3_base {-# NOINLINE i16_ptr #-} {-| __C declaration:__ @i16@ @@ -1926,9 +2928,15 @@ i16_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i16_ptr = unsafePerformIO hs_bindgen_625545a81d12a4a3 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c8e2d4272fd70085" hs_bindgen_c8e2d4272fd70085_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i17_ptr@ -} -foreign import ccall safe "hs_bindgen_c8e2d4272fd70085" hs_bindgen_c8e2d4272fd70085 :: IO (Ptr CInt) +hs_bindgen_c8e2d4272fd70085 :: IO (Ptr CInt) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i17_ptr@ +-} +hs_bindgen_c8e2d4272fd70085 = fromBaseForeignType hs_bindgen_c8e2d4272fd70085_base {-# NOINLINE i17_ptr #-} {-| __C declaration:__ @i17@ @@ -1944,9 +2952,15 @@ i17_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i17_ptr = unsafePerformIO hs_bindgen_c8e2d4272fd70085 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_50f4901f7ed0ca1d" hs_bindgen_50f4901f7ed0ca1d_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i18_ptr@ +-} +hs_bindgen_50f4901f7ed0ca1d :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i18_ptr@ -} -foreign import ccall safe "hs_bindgen_50f4901f7ed0ca1d" hs_bindgen_50f4901f7ed0ca1d :: IO (Ptr CInt) +hs_bindgen_50f4901f7ed0ca1d = fromBaseForeignType hs_bindgen_50f4901f7ed0ca1d_base {-# NOINLINE i18_ptr #-} {-| __C declaration:__ @i18@ @@ -1962,9 +2976,15 @@ i18_ptr :: Ptr CInt __exported by:__ @attributes\/visibility_attributes.h@ -} i18_ptr = unsafePerformIO hs_bindgen_50f4901f7ed0ca1d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e70a0a7f087993cf" hs_bindgen_e70a0a7f087993cf_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_attributesvisibility_attribut_Example_get_i19_ptr@ +-} +hs_bindgen_e70a0a7f087993cf :: IO (Ptr CInt) {-| __unique:__ @test_attributesvisibility_attribut_Example_get_i19_ptr@ -} -foreign import ccall safe "hs_bindgen_e70a0a7f087993cf" hs_bindgen_e70a0a7f087993cf :: IO (Ptr CInt) +hs_bindgen_e70a0a7f087993cf = fromBaseForeignType hs_bindgen_e70a0a7f087993cf_base {-# NOINLINE i19_ptr #-} {-| __C declaration:__ @i19@ diff --git a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/FunPtr.hs b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/FunPtr.hs index 8b11ab5cc..249caeb72 100644 --- a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/FunPtr.hs @@ -7,6 +7,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -23,10 +24,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2d056172b6e93949" hs_bindgen_2d056172b6e93949_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO ()))) + {-| __unique:__ @test_declarationsdeclarations_requ_Example_get_f_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2d056172b6e93949" hs_bindgen_2d056172b6e93949 :: +hs_bindgen_2d056172b6e93949 :: IO (Ptr.FunPtr (A -> IO ())) +hs_bindgen_2d056172b6e93949 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2d056172b6e93949_base {-# NOINLINE f_ptr #-} diff --git a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/Safe.hs b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/Safe.hs index eba5a1f7f..5d0252eb0 100644 --- a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/Safe.hs +++ b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/Safe.hs @@ -5,6 +5,7 @@ module Example.Safe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -19,6 +20,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0d1c75136a36e326" f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO ()) + {-| __C declaration:__ @f@ __defined at:__ @declarations\/declarations_required_for_scoping.h:7:6@ @@ -27,8 +33,10 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_declarationsdeclarations_requ_Example_Safe_f@ -} -foreign import ccall safe "hs_bindgen_0d1c75136a36e326" f :: +f :: A {- ^ __C declaration:__ @x@ -} -> IO () +f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f_base diff --git a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/Unsafe.hs b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/Unsafe.hs index c83312b92..83446cbac 100644 --- a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/Example/Unsafe.hs @@ -5,6 +5,7 @@ module Example.Unsafe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -19,6 +20,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_93ed1628a0edf6b0" f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO ()) + {-| __C declaration:__ @f@ __defined at:__ @declarations\/declarations_required_for_scoping.h:7:6@ @@ -27,8 +33,10 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_declarationsdeclarations_requ_Example_Unsafe_f@ -} -foreign import ccall unsafe "hs_bindgen_93ed1628a0edf6b0" f :: +f :: A {- ^ __C declaration:__ @x@ -} -> IO () +f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f_base diff --git a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/th.txt b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/th.txt index 8938d66f5..e50cc14bf 100644 --- a/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/th.txt +++ b/hs-bindgen/fixtures/declarations/declarations_required_for_scoping/th.txt @@ -47,6 +47,10 @@ newtype A Ix, Num, Real) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0d1c75136a36e326" f_base :: BaseForeignType (A -> + IO Unit) {-| __C declaration:__ @f@ __defined at:__ @declarations\/declarations_required_for_scoping.h:7:6@ @@ -55,8 +59,7 @@ newtype A __unique:__ @test_declarationsdeclarations_requ_Example_Unsafe_f@ -} -foreign import ccall safe "hs_bindgen_0d1c75136a36e326" f :: A -> - IO Unit +f :: A -> IO Unit {-| __C declaration:__ @f@ __defined at:__ @declarations\/declarations_required_for_scoping.h:7:6@ @@ -65,12 +68,39 @@ foreign import ccall safe "hs_bindgen_0d1c75136a36e326" f :: A -> __unique:__ @test_declarationsdeclarations_requ_Example_Unsafe_f@ -} -foreign import ccall safe "hs_bindgen_93ed1628a0edf6b0" f :: A -> - IO Unit +f = fromBaseForeignType f_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_93ed1628a0edf6b0" f_base :: BaseForeignType (A -> + IO Unit) +{-| __C declaration:__ @f@ + + __defined at:__ @declarations\/declarations_required_for_scoping.h:7:6@ + + __exported by:__ @declarations\/declarations_required_for_scoping.h@ + + __unique:__ @test_declarationsdeclarations_requ_Example_Unsafe_f@ +-} +f :: A -> IO Unit +{-| __C declaration:__ @f@ + + __defined at:__ @declarations\/declarations_required_for_scoping.h:7:6@ + + __exported by:__ @declarations\/declarations_required_for_scoping.h@ + + __unique:__ @test_declarationsdeclarations_requ_Example_Unsafe_f@ +-} +f = fromBaseForeignType f_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2d056172b6e93949" hs_bindgen_2d056172b6e93949_base :: BaseForeignType (IO (FunPtr (A -> + IO Unit))) +{-| __unique:__ @test_declarationsdeclarations_requ_Example_get_f_ptr@ +-} +hs_bindgen_2d056172b6e93949 :: IO (FunPtr (A -> IO Unit)) {-| __unique:__ @test_declarationsdeclarations_requ_Example_get_f_ptr@ -} -foreign import ccall safe "hs_bindgen_2d056172b6e93949" hs_bindgen_2d056172b6e93949 :: IO (FunPtr (A -> - IO Unit)) +hs_bindgen_2d056172b6e93949 = fromBaseForeignType hs_bindgen_2d056172b6e93949_base {-# NOINLINE f_ptr #-} {-| __C declaration:__ @f@ diff --git a/hs-bindgen/fixtures/declarations/definitions/Example/FunPtr.hs b/hs-bindgen/fixtures/declarations/definitions/Example/FunPtr.hs index 9e839928c..76c9e9c0a 100644 --- a/hs-bindgen/fixtures/declarations/definitions/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/declarations/definitions/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -23,10 +24,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bc546207e3a9a16e" hs_bindgen_bc546207e3a9a16e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CDouble -> IO FC.CInt))) + {-| __unique:__ @test_declarationsdefinitions_Example_get_foo_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bc546207e3a9a16e" hs_bindgen_bc546207e3a9a16e :: +hs_bindgen_bc546207e3a9a16e :: IO (Ptr.FunPtr (FC.CDouble -> IO FC.CInt)) +hs_bindgen_bc546207e3a9a16e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bc546207e3a9a16e_base {-# NOINLINE foo_ptr #-} diff --git a/hs-bindgen/fixtures/declarations/definitions/Example/Global.hs b/hs-bindgen/fixtures/declarations/definitions/Example/Global.hs index dcdefa68a..3de138de7 100644 --- a/hs-bindgen/fixtures/declarations/definitions/Example/Global.hs +++ b/hs-bindgen/fixtures/declarations/definitions/Example/Global.hs @@ -8,6 +8,7 @@ module Example.Global where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -21,10 +22,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d0561a54a41cb140" hs_bindgen_d0561a54a41cb140_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_declarationsdefinitions_Example_get_n_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d0561a54a41cb140" hs_bindgen_d0561a54a41cb140 :: +hs_bindgen_d0561a54a41cb140 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_d0561a54a41cb140 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d0561a54a41cb140_base {-# NOINLINE n_ptr #-} diff --git a/hs-bindgen/fixtures/declarations/definitions/Example/Safe.hs b/hs-bindgen/fixtures/declarations/definitions/Example/Safe.hs index 3db7d1beb..9c9dd4ae5 100644 --- a/hs-bindgen/fixtures/declarations/definitions/Example/Safe.hs +++ b/hs-bindgen/fixtures/declarations/definitions/Example/Safe.hs @@ -6,6 +6,7 @@ module Example.Safe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -19,6 +20,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9cdc88a6d09442d6" foo_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CDouble -> IO FC.CInt) + {-| __C declaration:__ @foo@ __defined at:__ @declarations\/definitions.h:13:5@ @@ -27,8 +33,10 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_declarationsdefinitions_Example_Safe_foo@ -} -foreign import ccall safe "hs_bindgen_9cdc88a6d09442d6" foo :: +foo :: FC.CDouble {- ^ __C declaration:__ @x@ -} -> IO FC.CInt +foo = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foo_base diff --git a/hs-bindgen/fixtures/declarations/definitions/Example/Unsafe.hs b/hs-bindgen/fixtures/declarations/definitions/Example/Unsafe.hs index de3c44fab..d00ac1ddf 100644 --- a/hs-bindgen/fixtures/declarations/definitions/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/declarations/definitions/Example/Unsafe.hs @@ -6,6 +6,7 @@ module Example.Unsafe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -19,6 +20,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_07fd5b433f381094" foo_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CDouble -> IO FC.CInt) + {-| __C declaration:__ @foo@ __defined at:__ @declarations\/definitions.h:13:5@ @@ -27,8 +33,10 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_declarationsdefinitions_Example_Unsafe_foo@ -} -foreign import ccall unsafe "hs_bindgen_07fd5b433f381094" foo :: +foo :: FC.CDouble {- ^ __C declaration:__ @x@ -} -> IO FC.CInt +foo = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foo_base diff --git a/hs-bindgen/fixtures/declarations/definitions/th.txt b/hs-bindgen/fixtures/declarations/definitions/th.txt index 9fdc3b6ed..e0e32c9fd 100644 --- a/hs-bindgen/fixtures/declarations/definitions/th.txt +++ b/hs-bindgen/fixtures/declarations/definitions/th.txt @@ -154,6 +154,32 @@ instance HasCField Y "y_o" instance TyEq ty (CFieldType Y "y_o") => HasField "y_o" (Ptr Y) (Ptr ty) where getField = ptrToCField (Proxy @"y_o") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9cdc88a6d09442d6" foo_base :: BaseForeignType (CDouble -> + IO CInt) +{-| __C declaration:__ @foo@ + + __defined at:__ @declarations\/definitions.h:13:5@ + + __exported by:__ @declarations\/definitions.h@ + + __unique:__ @test_declarationsdefinitions_Example_Unsafe_foo@ +-} +foo :: CDouble -> IO CInt +{-| __C declaration:__ @foo@ + + __defined at:__ @declarations\/definitions.h:13:5@ + + __exported by:__ @declarations\/definitions.h@ + + __unique:__ @test_declarationsdefinitions_Example_Unsafe_foo@ +-} +foo = fromBaseForeignType foo_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_07fd5b433f381094" foo_base :: BaseForeignType (CDouble -> + IO CInt) {-| __C declaration:__ @foo@ __defined at:__ @declarations\/definitions.h:13:5@ @@ -162,8 +188,7 @@ instance TyEq ty (CFieldType Y "y_o") => __unique:__ @test_declarationsdefinitions_Example_Unsafe_foo@ -} -foreign import ccall safe "hs_bindgen_9cdc88a6d09442d6" foo :: CDouble -> - IO CInt +foo :: CDouble -> IO CInt {-| __C declaration:__ @foo@ __defined at:__ @declarations\/definitions.h:13:5@ @@ -172,12 +197,17 @@ foreign import ccall safe "hs_bindgen_9cdc88a6d09442d6" foo :: CDouble -> __unique:__ @test_declarationsdefinitions_Example_Unsafe_foo@ -} -foreign import ccall safe "hs_bindgen_07fd5b433f381094" foo :: CDouble -> - IO CInt +foo = fromBaseForeignType foo_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bc546207e3a9a16e" hs_bindgen_bc546207e3a9a16e_base :: BaseForeignType (IO (FunPtr (CDouble -> + IO CInt))) +{-| __unique:__ @test_declarationsdefinitions_Example_get_foo_ptr@ +-} +hs_bindgen_bc546207e3a9a16e :: IO (FunPtr (CDouble -> IO CInt)) {-| __unique:__ @test_declarationsdefinitions_Example_get_foo_ptr@ -} -foreign import ccall safe "hs_bindgen_bc546207e3a9a16e" hs_bindgen_bc546207e3a9a16e :: IO (FunPtr (CDouble -> - IO CInt)) +hs_bindgen_bc546207e3a9a16e = fromBaseForeignType hs_bindgen_bc546207e3a9a16e_base {-# NOINLINE foo_ptr #-} {-| __C declaration:__ @foo@ @@ -193,9 +223,15 @@ foo_ptr :: FunPtr (CDouble -> IO CInt) __exported by:__ @declarations\/definitions.h@ -} foo_ptr = unsafePerformIO hs_bindgen_bc546207e3a9a16e +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d0561a54a41cb140" hs_bindgen_d0561a54a41cb140_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_declarationsdefinitions_Example_get_n_ptr@ +-} +hs_bindgen_d0561a54a41cb140 :: IO (Ptr CInt) {-| __unique:__ @test_declarationsdefinitions_Example_get_n_ptr@ -} -foreign import ccall safe "hs_bindgen_d0561a54a41cb140" hs_bindgen_d0561a54a41cb140 :: IO (Ptr CInt) +hs_bindgen_d0561a54a41cb140 = fromBaseForeignType hs_bindgen_d0561a54a41cb140_base {-# NOINLINE n_ptr #-} {-| __C declaration:__ @n@ diff --git a/hs-bindgen/fixtures/declarations/redeclaration/Example/Global.hs b/hs-bindgen/fixtures/declarations/redeclaration/Example/Global.hs index bfd89b856..ec0a8edbb 100644 --- a/hs-bindgen/fixtures/declarations/redeclaration/Example/Global.hs +++ b/hs-bindgen/fixtures/declarations/redeclaration/Example/Global.hs @@ -8,6 +8,7 @@ module Example.Global where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -21,10 +22,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_795a6cca43448561" hs_bindgen_795a6cca43448561_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_declarationsredeclaration_Example_get_x_ptr@ -} -foreign import ccall unsafe "hs_bindgen_795a6cca43448561" hs_bindgen_795a6cca43448561 :: +hs_bindgen_795a6cca43448561 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_795a6cca43448561 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_795a6cca43448561_base {-# NOINLINE x_ptr #-} diff --git a/hs-bindgen/fixtures/declarations/redeclaration/th.txt b/hs-bindgen/fixtures/declarations/redeclaration/th.txt index 8a8c0e1d5..1c64b1882 100644 --- a/hs-bindgen/fixtures/declarations/redeclaration/th.txt +++ b/hs-bindgen/fixtures/declarations/redeclaration/th.txt @@ -172,9 +172,15 @@ instance HasCField Y "y_o" instance TyEq ty (CFieldType Y "y_o") => HasField "y_o" (Ptr Y) (Ptr ty) where getField = ptrToCField (Proxy @"y_o") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_795a6cca43448561" hs_bindgen_795a6cca43448561_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_declarationsredeclaration_Example_get_x_ptr@ +-} +hs_bindgen_795a6cca43448561 :: IO (Ptr CInt) {-| __unique:__ @test_declarationsredeclaration_Example_get_x_ptr@ -} -foreign import ccall safe "hs_bindgen_795a6cca43448561" hs_bindgen_795a6cca43448561 :: IO (Ptr CInt) +hs_bindgen_795a6cca43448561 = fromBaseForeignType hs_bindgen_795a6cca43448561_base {-# NOINLINE x_ptr #-} {-| __C declaration:__ @x@ diff --git a/hs-bindgen/fixtures/declarations/tentative_definitions/Example/Global.hs b/hs-bindgen/fixtures/declarations/tentative_definitions/Example/Global.hs index 1c1ee227e..40401c1c2 100644 --- a/hs-bindgen/fixtures/declarations/tentative_definitions/Example/Global.hs +++ b/hs-bindgen/fixtures/declarations/tentative_definitions/Example/Global.hs @@ -8,6 +8,7 @@ module Example.Global where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -33,10 +34,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a6c085c30d844c6a" hs_bindgen_a6c085c30d844c6a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_declarationstentative_definit_Example_get_i1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a6c085c30d844c6a" hs_bindgen_a6c085c30d844c6a :: +hs_bindgen_a6c085c30d844c6a :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_a6c085c30d844c6a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a6c085c30d844c6a_base {-# NOINLINE i1_ptr #-} @@ -50,10 +58,17 @@ i1_ptr :: Ptr.Ptr FC.CInt i1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a6c085c30d844c6a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f63a7b78dc0eb182" hs_bindgen_f63a7b78dc0eb182_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_declarationstentative_definit_Example_get_i2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f63a7b78dc0eb182" hs_bindgen_f63a7b78dc0eb182 :: +hs_bindgen_f63a7b78dc0eb182 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_f63a7b78dc0eb182 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f63a7b78dc0eb182_base {-# NOINLINE i2_ptr #-} @@ -67,10 +82,17 @@ i2_ptr :: Ptr.Ptr FC.CInt i2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f63a7b78dc0eb182 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_927fb780e7e73ba1" hs_bindgen_927fb780e7e73ba1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_declarationstentative_definit_Example_get_i3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_927fb780e7e73ba1" hs_bindgen_927fb780e7e73ba1 :: +hs_bindgen_927fb780e7e73ba1 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_927fb780e7e73ba1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_927fb780e7e73ba1_base {-# NOINLINE i3_ptr #-} diff --git a/hs-bindgen/fixtures/declarations/tentative_definitions/th.txt b/hs-bindgen/fixtures/declarations/tentative_definitions/th.txt index 12d9d5225..cfcdd912f 100644 --- a/hs-bindgen/fixtures/declarations/tentative_definitions/th.txt +++ b/hs-bindgen/fixtures/declarations/tentative_definitions/th.txt @@ -18,9 +18,15 @@ -- { -- return &i3; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a6c085c30d844c6a" hs_bindgen_a6c085c30d844c6a_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_declarationstentative_definit_Example_get_i1_ptr@ +-} +hs_bindgen_a6c085c30d844c6a :: IO (Ptr CInt) {-| __unique:__ @test_declarationstentative_definit_Example_get_i1_ptr@ -} -foreign import ccall safe "hs_bindgen_a6c085c30d844c6a" hs_bindgen_a6c085c30d844c6a :: IO (Ptr CInt) +hs_bindgen_a6c085c30d844c6a = fromBaseForeignType hs_bindgen_a6c085c30d844c6a_base {-# NOINLINE i1_ptr #-} {-| __C declaration:__ @i1@ @@ -36,9 +42,15 @@ i1_ptr :: Ptr CInt __exported by:__ @declarations\/tentative_definitions.h@ -} i1_ptr = unsafePerformIO hs_bindgen_a6c085c30d844c6a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f63a7b78dc0eb182" hs_bindgen_f63a7b78dc0eb182_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_declarationstentative_definit_Example_get_i2_ptr@ -} -foreign import ccall safe "hs_bindgen_f63a7b78dc0eb182" hs_bindgen_f63a7b78dc0eb182 :: IO (Ptr CInt) +hs_bindgen_f63a7b78dc0eb182 :: IO (Ptr CInt) +{-| __unique:__ @test_declarationstentative_definit_Example_get_i2_ptr@ +-} +hs_bindgen_f63a7b78dc0eb182 = fromBaseForeignType hs_bindgen_f63a7b78dc0eb182_base {-# NOINLINE i2_ptr #-} {-| __C declaration:__ @i2@ @@ -54,9 +66,15 @@ i2_ptr :: Ptr CInt __exported by:__ @declarations\/tentative_definitions.h@ -} i2_ptr = unsafePerformIO hs_bindgen_f63a7b78dc0eb182 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_927fb780e7e73ba1" hs_bindgen_927fb780e7e73ba1_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_declarationstentative_definit_Example_get_i3_ptr@ +-} +hs_bindgen_927fb780e7e73ba1 :: IO (Ptr CInt) {-| __unique:__ @test_declarationstentative_definit_Example_get_i3_ptr@ -} -foreign import ccall safe "hs_bindgen_927fb780e7e73ba1" hs_bindgen_927fb780e7e73ba1 :: IO (Ptr CInt) +hs_bindgen_927fb780e7e73ba1 = fromBaseForeignType hs_bindgen_927fb780e7e73ba1_base {-# NOINLINE i3_ptr #-} {-| __C declaration:__ @i3@ diff --git a/hs-bindgen/fixtures/documentation/doxygen_docs/Example/FunPtr.hs b/hs-bindgen/fixtures/documentation/doxygen_docs/Example/FunPtr.hs index 77795ec06..79185c3dc 100644 --- a/hs-bindgen/fixtures/documentation/doxygen_docs/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/documentation/doxygen_docs/Example/FunPtr.hs @@ -10,6 +10,7 @@ import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) import Example @@ -148,10 +149,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_00ad1c4db6c865d6" hs_bindgen_00ad1c4db6c865d6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.CSize) -> IO FC.CInt))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_process_data_ptr@ -} -foreign import ccall unsafe "hs_bindgen_00ad1c4db6c865d6" hs_bindgen_00ad1c4db6c865d6 :: +hs_bindgen_00ad1c4db6c865d6 :: IO (Ptr.FunPtr ((Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.CSize) -> IO FC.CInt)) +hs_bindgen_00ad1c4db6c865d6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_00ad1c4db6c865d6_base {-# NOINLINE process_data_ptr #-} @@ -179,10 +187,17 @@ process_data_ptr :: Ptr.FunPtr ((Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> (Pt process_data_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_00ad1c4db6c865d6 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_17f9c7a037fa2ddf" hs_bindgen_17f9c7a037fa2ddf_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CBool))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_process_file_ptr@ -} -foreign import ccall unsafe "hs_bindgen_17f9c7a037fa2ddf" hs_bindgen_17f9c7a037fa2ddf :: +hs_bindgen_17f9c7a037fa2ddf :: IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CBool)) +hs_bindgen_17f9c7a037fa2ddf = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_17f9c7a037fa2ddf_base {-# NOINLINE process_file_ptr #-} @@ -206,10 +221,17 @@ process_file_ptr :: Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CBool) process_file_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_17f9c7a037fa2ddf +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8b08d5b99efae93b" hs_bindgen_8b08d5b99efae93b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_calculate_value_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8b08d5b99efae93b" hs_bindgen_8b08d5b99efae93b :: +hs_bindgen_8b08d5b99efae93b :: IO (Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt)) +hs_bindgen_8b08d5b99efae93b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8b08d5b99efae93b_base {-# NOINLINE calculate_value_ptr #-} @@ -240,10 +262,17 @@ calculate_value_ptr :: Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt) calculate_value_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8b08d5b99efae93b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bb00e40be97757d6" hs_bindgen_bb00e40be97757d6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CBool))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_html_example_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bb00e40be97757d6" hs_bindgen_bb00e40be97757d6 :: +hs_bindgen_bb00e40be97757d6 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CBool)) +hs_bindgen_bb00e40be97757d6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bb00e40be97757d6_base {-# NOINLINE html_example_ptr #-} @@ -269,10 +298,17 @@ html_example_ptr :: Ptr.FunPtr (FC.CInt -> IO FC.CBool) html_example_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bb00e40be97757d6 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e53b2ca51c16f7df" hs_bindgen_e53b2ca51c16f7df_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr (Ptr.Ptr FC.CChar)) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CBool))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_list_example_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e53b2ca51c16f7df" hs_bindgen_e53b2ca51c16f7df :: +hs_bindgen_e53b2ca51c16f7df :: IO (Ptr.FunPtr ((Ptr.Ptr (Ptr.Ptr FC.CChar)) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CBool)) +hs_bindgen_e53b2ca51c16f7df = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e53b2ca51c16f7df_base {-# NOINLINE list_example_ptr #-} @@ -326,10 +362,17 @@ list_example_ptr :: Ptr.FunPtr ((Ptr.Ptr (Ptr.Ptr FC.CChar)) -> HsBindgen.Runtim list_example_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e53b2ca51c16f7df +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6f8fafd779560b0a" hs_bindgen_6f8fafd779560b0a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Void) -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_dangerous_function_ptr@ -} -foreign import ccall unsafe "hs_bindgen_6f8fafd779560b0a" hs_bindgen_6f8fafd779560b0a :: +hs_bindgen_6f8fafd779560b0a :: IO (Ptr.FunPtr ((Ptr.Ptr Void) -> IO (Ptr.Ptr Void))) +hs_bindgen_6f8fafd779560b0a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_6f8fafd779560b0a_base {-# NOINLINE dangerous_function_ptr #-} @@ -357,10 +400,17 @@ dangerous_function_ptr :: Ptr.FunPtr ((Ptr.Ptr Void) -> IO (Ptr.Ptr Void)) dangerous_function_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_6f8fafd779560b0a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8316611dfa87497d" hs_bindgen_8316611dfa87497d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CInt))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_detailed_return_codes_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8316611dfa87497d" hs_bindgen_8316611dfa87497d :: +hs_bindgen_8316611dfa87497d :: IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CInt)) +hs_bindgen_8316611dfa87497d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8316611dfa87497d_base {-# NOINLINE detailed_return_codes_ptr #-} @@ -388,10 +438,17 @@ detailed_return_codes_ptr :: Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CInt) detailed_return_codes_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8316611dfa87497d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9658582afd412d05" hs_bindgen_9658582afd412d05_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_old_function_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9658582afd412d05" hs_bindgen_9658582afd412d05 :: +hs_bindgen_9658582afd412d05 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_9658582afd412d05 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9658582afd412d05_base {-# NOINLINE old_function_ptr #-} @@ -415,10 +472,17 @@ old_function_ptr :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) old_function_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9658582afd412d05 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fed78653b04cad56" hs_bindgen_fed78653b04cad56_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_versioned_function_ptr@ -} -foreign import ccall unsafe "hs_bindgen_fed78653b04cad56" hs_bindgen_fed78653b04cad56 :: +hs_bindgen_fed78653b04cad56 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_fed78653b04cad56 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_fed78653b04cad56_base {-# NOINLINE versioned_function_ptr #-} @@ -442,10 +506,17 @@ versioned_function_ptr :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) versioned_function_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_fed78653b04cad56 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_54ecd4981536e33b" hs_bindgen_54ecd4981536e33b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 64) FC.CChar) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CInt))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_process_buffer_ptr@ -} -foreign import ccall unsafe "hs_bindgen_54ecd4981536e33b" hs_bindgen_54ecd4981536e33b :: +hs_bindgen_54ecd4981536e33b :: IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 64) FC.CChar) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CInt)) +hs_bindgen_54ecd4981536e33b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_54ecd4981536e33b_base {-# NOINLINE process_buffer_ptr #-} @@ -469,10 +540,17 @@ process_buffer_ptr :: Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArra process_buffer_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_54ecd4981536e33b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f3280e35cf2dec18" hs_bindgen_f3280e35cf2dec18_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> HsBindgen.Runtime.Prelude.CSize -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_my_memcpy_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f3280e35cf2dec18" hs_bindgen_f3280e35cf2dec18 :: +hs_bindgen_f3280e35cf2dec18 :: IO (Ptr.FunPtr ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> HsBindgen.Runtime.Prelude.CSize -> IO (Ptr.Ptr Void))) +hs_bindgen_f3280e35cf2dec18 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f3280e35cf2dec18_base {-# NOINLINE my_memcpy_ptr #-} @@ -498,10 +576,17 @@ my_memcpy_ptr :: Ptr.FunPtr ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> HsBindgen.Runti my_memcpy_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f3280e35cf2dec18 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3c5017e63542a732" hs_bindgen_3c5017e63542a732_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_double_value_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3c5017e63542a732" hs_bindgen_3c5017e63542a732 :: +hs_bindgen_3c5017e63542a732 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_3c5017e63542a732 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3c5017e63542a732_base {-# NOINLINE double_value_ptr #-} @@ -523,10 +608,17 @@ double_value_ptr :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) double_value_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3c5017e63542a732 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5c7ef3361588f78d" hs_bindgen_5c7ef3361588f78d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Config_t) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> HsBindgen.Runtime.Prelude.CSize -> IO Status_code_t))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_complex_function_ptr@ -} -foreign import ccall unsafe "hs_bindgen_5c7ef3361588f78d" hs_bindgen_5c7ef3361588f78d :: +hs_bindgen_5c7ef3361588f78d :: IO (Ptr.FunPtr ((Ptr.Ptr Config_t) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> HsBindgen.Runtime.Prelude.CSize -> IO Status_code_t)) +hs_bindgen_5c7ef3361588f78d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_5c7ef3361588f78d_base {-# NOINLINE complex_function_ptr #-} @@ -605,10 +697,17 @@ complex_function_ptr :: Ptr.FunPtr ((Ptr.Ptr Config_t) -> (Ptr.Ptr HsBindgen.Run complex_function_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_5c7ef3361588f78d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c5116c8a533d238c" hs_bindgen_c5116c8a533d238c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CInt))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_hash_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c5116c8a533d238c" hs_bindgen_c5116c8a533d238c :: +hs_bindgen_c5116c8a533d238c :: IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CInt)) +hs_bindgen_c5116c8a533d238c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c5116c8a533d238c_base {-# NOINLINE hash_ptr #-} @@ -622,10 +721,17 @@ hash_ptr :: Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CInt) hash_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c5116c8a533d238c +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f488217ac3b07e44" hs_bindgen_f488217ac3b07e44_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_square_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f488217ac3b07e44" hs_bindgen_f488217ac3b07e44 :: +hs_bindgen_f488217ac3b07e44 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_f488217ac3b07e44 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f488217ac3b07e44_base {-# NOINLINE square_ptr #-} diff --git a/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Global.hs b/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Global.hs index b5a148cf3..86c04d663 100644 --- a/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Global.hs +++ b/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Global.hs @@ -8,6 +8,7 @@ module Example.Global where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -27,10 +28,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a568b76e8feb0427" hs_bindgen_a568b76e8feb0427_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_global_counter_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a568b76e8feb0427" hs_bindgen_a568b76e8feb0427 :: +hs_bindgen_a568b76e8feb0427 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_a568b76e8feb0427 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a568b76e8feb0427_base {-# NOINLINE global_counter_ptr #-} @@ -52,10 +60,17 @@ global_counter_ptr :: Ptr.Ptr FC.CInt global_counter_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a568b76e8feb0427 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dd671052fd43d189" hs_bindgen_dd671052fd43d189_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.Ptr FC.CChar))) + {-| __unique:__ @test_documentationdoxygen_docs_Example_get_version_string_ptr@ -} -foreign import ccall unsafe "hs_bindgen_dd671052fd43d189" hs_bindgen_dd671052fd43d189 :: +hs_bindgen_dd671052fd43d189 :: IO (Ptr.Ptr (Ptr.Ptr FC.CChar)) +hs_bindgen_dd671052fd43d189 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_dd671052fd43d189_base {-# NOINLINE version_string_ptr #-} diff --git a/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Safe.hs b/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Safe.hs index dbaeeb280..35a48952e 100644 --- a/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Safe.hs +++ b/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Safe.hs @@ -7,6 +7,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) import Example @@ -115,6 +116,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7eada9f65d982412" process_data_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.CSize) -> IO FC.CInt) + {-| Function with detailed parameter documentation @@ -137,7 +143,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_process_data@ -} -foreign import ccall safe "hs_bindgen_7eada9f65d982412" process_data :: +process_data :: Ptr.Ptr HsBindgen.Runtime.Prelude.Word8 {- ^ @@ -160,6 +166,13 @@ foreign import ccall safe "hs_bindgen_7eada9f65d982412" process_data :: __C declaration:__ @size@ -} -> IO FC.CInt +process_data = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType process_data_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fb85499c501da1a7" process_file_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> IO FC.CBool) {-| @@ -179,7 +192,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_process_file@ -} -foreign import ccall safe "hs_bindgen_fb85499c501da1a7" process_file :: +process_file :: Ptr.Ptr FC.CChar {- ^ @@ -188,6 +201,13 @@ foreign import ccall safe "hs_bindgen_fb85499c501da1a7" process_file :: __C declaration:__ @filename@ -} -> IO FC.CBool +process_file = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType process_file_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a73fc7b108035c5c" calculate_value_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt -> IO FC.CInt) {-| @@ -214,7 +234,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_calculate_value@ -} -foreign import ccall safe "hs_bindgen_a73fc7b108035c5c" calculate_value :: +calculate_value :: FC.CInt {- ^ @@ -230,6 +250,13 @@ foreign import ccall safe "hs_bindgen_a73fc7b108035c5c" calculate_value :: __C declaration:__ @multiplier@ -} -> IO FC.CInt +calculate_value = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType calculate_value_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9b7f6745401b4652" html_example_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CBool) {-| @@ -251,7 +278,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_html_example@ -} -foreign import ccall safe "hs_bindgen_9b7f6745401b4652" html_example :: +html_example :: FC.CInt {- ^ @@ -260,6 +287,13 @@ foreign import ccall safe "hs_bindgen_9b7f6745401b4652" html_example :: __C declaration:__ @value@ -} -> IO FC.CBool +html_example = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType html_example_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_825411dc114e599b" list_example_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr FC.CChar)) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CBool) {-| @@ -309,7 +343,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_list_example@ -} -foreign import ccall safe "hs_bindgen_825411dc114e599b" list_example :: +list_example :: Ptr.Ptr (Ptr.Ptr FC.CChar) {- ^ @@ -325,6 +359,13 @@ foreign import ccall safe "hs_bindgen_825411dc114e599b" list_example :: __C declaration:__ @count@ -} -> IO FC.CBool +list_example = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType list_example_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_17264dcff7e9b698" dangerous_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Void) -> IO (Ptr.Ptr Void)) {-| @@ -348,7 +389,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_dangerous_function@ -} -foreign import ccall safe "hs_bindgen_17264dcff7e9b698" dangerous_function :: +dangerous_function :: Ptr.Ptr Void {- ^ @@ -357,6 +398,13 @@ foreign import ccall safe "hs_bindgen_17264dcff7e9b698" dangerous_function :: __C declaration:__ @ptr@ -} -> IO (Ptr.Ptr Void) +dangerous_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType dangerous_function_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c8ca619ec2e70d8d" detailed_return_codes_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> IO FC.CInt) {-| @@ -380,7 +428,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_detailed_return_codes@ -} -foreign import ccall safe "hs_bindgen_c8ca619ec2e70d8d" detailed_return_codes :: +detailed_return_codes :: Ptr.Ptr FC.CChar {- ^ @@ -389,6 +437,13 @@ foreign import ccall safe "hs_bindgen_c8ca619ec2e70d8d" detailed_return_codes :: __C declaration:__ @input@ -} -> IO FC.CInt +detailed_return_codes = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType detailed_return_codes_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_25e1070e2ce10048" old_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) {-| @@ -408,7 +463,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_old_function@ -} -foreign import ccall safe "hs_bindgen_25e1070e2ce10048" old_function :: +old_function :: FC.CInt {- ^ @@ -417,6 +472,13 @@ foreign import ccall safe "hs_bindgen_25e1070e2ce10048" old_function :: __C declaration:__ @old_param@ -} -> IO FC.CInt +old_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType old_function_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a9eeeb09808e71cc" versioned_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) {-| @@ -436,11 +498,18 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_versioned_function@ -} -foreign import ccall safe "hs_bindgen_a9eeeb09808e71cc" versioned_function :: +versioned_function :: FC.CInt {- ^ __C declaration:__ @data'@ -} -> IO FC.CInt +versioned_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType versioned_function_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0c0057f1700372a7" process_buffer_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CInt) {-| @@ -460,7 +529,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_process_buffer@ -} -foreign import ccall safe "hs_bindgen_0c0057f1700372a7" process_buffer :: +process_buffer :: Ptr.Ptr FC.CChar {- ^ @@ -476,6 +545,13 @@ foreign import ccall safe "hs_bindgen_0c0057f1700372a7" process_buffer :: __C declaration:__ @size@ -} -> IO FC.CInt +process_buffer = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType process_buffer_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_294db77671f95524" my_memcpy_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> HsBindgen.Runtime.Prelude.CSize -> IO (Ptr.Ptr Void)) {-| @@ -497,7 +573,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_my_memcpy@ -} -foreign import ccall safe "hs_bindgen_294db77671f95524" my_memcpy :: +my_memcpy :: Ptr.Ptr Void {- ^ @@ -520,6 +596,13 @@ foreign import ccall safe "hs_bindgen_294db77671f95524" my_memcpy :: __C declaration:__ @n@ -} -> IO (Ptr.Ptr Void) +my_memcpy = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_memcpy_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f5bc63a9952c2618" double_value_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) {-| @@ -537,7 +620,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_double_value@ -} -foreign import ccall safe "hs_bindgen_f5bc63a9952c2618" double_value :: +double_value :: FC.CInt {- ^ @@ -546,6 +629,13 @@ foreign import ccall safe "hs_bindgen_f5bc63a9952c2618" double_value :: __C declaration:__ @x@ -} -> IO FC.CInt +double_value = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType double_value_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c4e7e99dba20204d" complex_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Config_t) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> HsBindgen.Runtime.Prelude.CSize -> IO Status_code_t) {-| @@ -620,7 +710,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_complex_function@ -} -foreign import ccall safe "hs_bindgen_c4e7e99dba20204d" complex_function :: +complex_function :: Ptr.Ptr Config_t {- ^ @@ -639,6 +729,13 @@ foreign import ccall safe "hs_bindgen_c4e7e99dba20204d" complex_function :: __C declaration:__ @size@ -} -> IO Status_code_t +complex_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType complex_function_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_935f2aead358d9ef" hash_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> IO FC.CInt) {-| @@ -652,11 +749,18 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Safe_hash@ -} -foreign import ccall safe "hs_bindgen_935f2aead358d9ef" hash :: +hash :: Ptr.Ptr FC.CChar {- ^ __C declaration:__ @s@ -} -> IO FC.CInt +hash = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hash_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_39fef54c23d4e1ee" square_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) {-| __C declaration:__ @square@ @@ -666,8 +770,10 @@ foreign import ccall safe "hs_bindgen_935f2aead358d9ef" hash :: __unique:__ @test_documentationdoxygen_docs_Example_Safe_square@ -} -foreign import ccall safe "hs_bindgen_39fef54c23d4e1ee" square :: +square :: FC.CInt {- ^ __C declaration:__ @x@ -} -> FC.CInt +square = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_base diff --git a/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Unsafe.hs b/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Unsafe.hs index c97bc2c2e..3c175d714 100644 --- a/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/documentation/doxygen_docs/Example/Unsafe.hs @@ -7,6 +7,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) import Example @@ -115,6 +116,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e6085a910ba41ecb" process_data_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.CSize) -> IO FC.CInt) + {-| Function with detailed parameter documentation @@ -137,7 +143,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_data@ -} -foreign import ccall unsafe "hs_bindgen_e6085a910ba41ecb" process_data :: +process_data :: Ptr.Ptr HsBindgen.Runtime.Prelude.Word8 {- ^ @@ -160,6 +166,13 @@ foreign import ccall unsafe "hs_bindgen_e6085a910ba41ecb" process_data :: __C declaration:__ @size@ -} -> IO FC.CInt +process_data = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType process_data_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c27e893aea0b0a77" process_file_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> IO FC.CBool) {-| @@ -179,7 +192,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_file@ -} -foreign import ccall unsafe "hs_bindgen_c27e893aea0b0a77" process_file :: +process_file :: Ptr.Ptr FC.CChar {- ^ @@ -188,6 +201,13 @@ foreign import ccall unsafe "hs_bindgen_c27e893aea0b0a77" process_file :: __C declaration:__ @filename@ -} -> IO FC.CBool +process_file = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType process_file_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bc1b0e25a72f4ec0" calculate_value_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt -> IO FC.CInt) {-| @@ -214,7 +234,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_calculate_value@ -} -foreign import ccall unsafe "hs_bindgen_bc1b0e25a72f4ec0" calculate_value :: +calculate_value :: FC.CInt {- ^ @@ -230,6 +250,13 @@ foreign import ccall unsafe "hs_bindgen_bc1b0e25a72f4ec0" calculate_value :: __C declaration:__ @multiplier@ -} -> IO FC.CInt +calculate_value = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType calculate_value_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_09abc3cb74562964" html_example_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CBool) {-| @@ -251,7 +278,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_html_example@ -} -foreign import ccall unsafe "hs_bindgen_09abc3cb74562964" html_example :: +html_example :: FC.CInt {- ^ @@ -260,6 +287,13 @@ foreign import ccall unsafe "hs_bindgen_09abc3cb74562964" html_example :: __C declaration:__ @value@ -} -> IO FC.CBool +html_example = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType html_example_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_47cba1a95d265f84" list_example_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr FC.CChar)) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CBool) {-| @@ -309,7 +343,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_list_example@ -} -foreign import ccall unsafe "hs_bindgen_47cba1a95d265f84" list_example :: +list_example :: Ptr.Ptr (Ptr.Ptr FC.CChar) {- ^ @@ -325,6 +359,13 @@ foreign import ccall unsafe "hs_bindgen_47cba1a95d265f84" list_example :: __C declaration:__ @count@ -} -> IO FC.CBool +list_example = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType list_example_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e065fc013e4eccd6" dangerous_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Void) -> IO (Ptr.Ptr Void)) {-| @@ -348,7 +389,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_dangerous_function@ -} -foreign import ccall unsafe "hs_bindgen_e065fc013e4eccd6" dangerous_function :: +dangerous_function :: Ptr.Ptr Void {- ^ @@ -357,6 +398,13 @@ foreign import ccall unsafe "hs_bindgen_e065fc013e4eccd6" dangerous_function :: __C declaration:__ @ptr@ -} -> IO (Ptr.Ptr Void) +dangerous_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType dangerous_function_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bc4f7e24b2ad4ace" detailed_return_codes_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> IO FC.CInt) {-| @@ -380,7 +428,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_detailed_return_codes@ -} -foreign import ccall unsafe "hs_bindgen_bc4f7e24b2ad4ace" detailed_return_codes :: +detailed_return_codes :: Ptr.Ptr FC.CChar {- ^ @@ -389,6 +437,13 @@ foreign import ccall unsafe "hs_bindgen_bc4f7e24b2ad4ace" detailed_return_codes __C declaration:__ @input@ -} -> IO FC.CInt +detailed_return_codes = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType detailed_return_codes_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8deec146389ae8b3" old_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) {-| @@ -408,7 +463,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_old_function@ -} -foreign import ccall unsafe "hs_bindgen_8deec146389ae8b3" old_function :: +old_function :: FC.CInt {- ^ @@ -417,6 +472,13 @@ foreign import ccall unsafe "hs_bindgen_8deec146389ae8b3" old_function :: __C declaration:__ @old_param@ -} -> IO FC.CInt +old_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType old_function_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_da2dcc1473935665" versioned_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) {-| @@ -436,11 +498,18 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_versioned_function@ -} -foreign import ccall unsafe "hs_bindgen_da2dcc1473935665" versioned_function :: +versioned_function :: FC.CInt {- ^ __C declaration:__ @data'@ -} -> IO FC.CInt +versioned_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType versioned_function_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_97c1191917e6eece" process_buffer_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CInt) {-| @@ -460,7 +529,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_buffer@ -} -foreign import ccall unsafe "hs_bindgen_97c1191917e6eece" process_buffer :: +process_buffer :: Ptr.Ptr FC.CChar {- ^ @@ -476,6 +545,13 @@ foreign import ccall unsafe "hs_bindgen_97c1191917e6eece" process_buffer :: __C declaration:__ @size@ -} -> IO FC.CInt +process_buffer = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType process_buffer_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_58253bb560dc3eb3" my_memcpy_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> HsBindgen.Runtime.Prelude.CSize -> IO (Ptr.Ptr Void)) {-| @@ -497,7 +573,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_my_memcpy@ -} -foreign import ccall unsafe "hs_bindgen_58253bb560dc3eb3" my_memcpy :: +my_memcpy :: Ptr.Ptr Void {- ^ @@ -520,6 +596,13 @@ foreign import ccall unsafe "hs_bindgen_58253bb560dc3eb3" my_memcpy :: __C declaration:__ @n@ -} -> IO (Ptr.Ptr Void) +my_memcpy = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_memcpy_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_44dd19b16ee38e5b" double_value_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) {-| @@ -537,7 +620,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_double_value@ -} -foreign import ccall unsafe "hs_bindgen_44dd19b16ee38e5b" double_value :: +double_value :: FC.CInt {- ^ @@ -546,6 +629,13 @@ foreign import ccall unsafe "hs_bindgen_44dd19b16ee38e5b" double_value :: __C declaration:__ @x@ -} -> IO FC.CInt +double_value = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType double_value_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fd6fce7c8d8b2f79" complex_function_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Config_t) -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> HsBindgen.Runtime.Prelude.CSize -> IO Status_code_t) {-| @@ -620,7 +710,7 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_complex_function@ -} -foreign import ccall unsafe "hs_bindgen_fd6fce7c8d8b2f79" complex_function :: +complex_function :: Ptr.Ptr Config_t {- ^ @@ -639,6 +729,13 @@ foreign import ccall unsafe "hs_bindgen_fd6fce7c8d8b2f79" complex_function :: __C declaration:__ @size@ -} -> IO Status_code_t +complex_function = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType complex_function_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dd36c8b317ccfcc4" hash_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> IO FC.CInt) {-| @@ -652,11 +749,18 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_hash@ -} -foreign import ccall unsafe "hs_bindgen_dd36c8b317ccfcc4" hash :: +hash :: Ptr.Ptr FC.CChar {- ^ __C declaration:__ @s@ -} -> IO FC.CInt +hash = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hash_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6875e30a7fe8d30a" square_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) {-| __C declaration:__ @square@ @@ -666,8 +770,10 @@ foreign import ccall unsafe "hs_bindgen_dd36c8b317ccfcc4" hash :: __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_square@ -} -foreign import ccall unsafe "hs_bindgen_6875e30a7fe8d30a" square :: +square :: FC.CInt {- ^ __C declaration:__ @x@ -} -> FC.CInt +square = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_base diff --git a/hs-bindgen/fixtures/documentation/doxygen_docs/th.txt b/hs-bindgen/fixtures/documentation/doxygen_docs/th.txt index 0db69c40b..518bb5911 100644 --- a/hs-bindgen/fixtures/documentation/doxygen_docs/th.txt +++ b/hs-bindgen/fixtures/documentation/doxygen_docs/th.txt @@ -1466,6 +1466,37 @@ instance TyEq ty (CFieldType Flexible_array "flexible_array_count") => HasField "flexible_array_count" (Ptr Flexible_array) (Ptr ty) where getField = ptrToCField (Proxy @"flexible_array_count") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7eada9f65d982412" process_data_base :: BaseForeignType (Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.CSize -> + IO CInt) +{-| + + Function with detailed parameter documentation + + This function shows different parameter directions and types. + + [__@input_data@ /(input)/__]: Input data buffer + + [__@output_data@ /(output)/__]: Output data buffer + + [__@size@ /(input,output)/__]: Size of data, updated on return + + __returns:__ Status code (0 = success, -1 = error) + +__C declaration:__ @process_data@ + +__defined at:__ @documentation\/doxygen_docs.h:105:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_data@ +-} +process_data :: Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.CSize -> IO CInt {-| Function with detailed parameter documentation @@ -1488,10 +1519,30 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_data@ -} -foreign import ccall safe "hs_bindgen_7eada9f65d982412" process_data :: Ptr HsBindgen.Runtime.Prelude.Word8 -> - Ptr HsBindgen.Runtime.Prelude.Word8 -> - Ptr HsBindgen.Runtime.Prelude.CSize -> - IO CInt +process_data = fromBaseForeignType process_data_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fb85499c501da1a7" process_file_base :: BaseForeignType (Ptr CChar -> + IO CBool) +{-| + + Function with inline commands and formatting + + This function uses @inline@ @code@ formatting and __bold__ text. It also demonstrates /emphasized/ text. + + [__@filename@ /(input)/__]: The @char*@ filename to process + + __returns:__ @true@ if successful, @false@ otherwise + +__C declaration:__ @process_file@ + +__defined at:__ @documentation\/doxygen_docs.h:116:6@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_file@ +-} +process_file :: Ptr CChar -> IO CBool {-| Function with inline commands and formatting @@ -1510,8 +1561,38 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_file@ -} -foreign import ccall safe "hs_bindgen_fb85499c501da1a7" process_file :: Ptr CChar -> - IO CBool +process_file = fromBaseForeignType process_file_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a73fc7b108035c5c" calculate_value_base :: BaseForeignType (CInt -> + CInt -> + IO CInt) +{-| + + Function with verbatim code blocks + + Example usage: + + @ + int result = calculate_value(10, 20); + printf("Result: %d@n", result); + @ + + [__@base@ /(input)/__]: Base value + + [__@multiplier@ /(input)/__]: Multiplier value + + __returns:__ Calculated result + +__C declaration:__ @calculate_value@ + +__defined at:__ @documentation\/doxygen_docs.h:131:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_calculate_value@ +-} +calculate_value :: CInt -> CInt -> IO CInt {-| Function with verbatim code blocks @@ -1537,8 +1618,32 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_calculate_value@ -} -foreign import ccall safe "hs_bindgen_a73fc7b108035c5c" calculate_value :: CInt -> - CInt -> IO CInt +calculate_value = fromBaseForeignType calculate_value_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9b7f6745401b4652" html_example_base :: BaseForeignType (CInt -> + IO CBool) +{-| + + Function with HTML formatting + + This function demonstrates HTML bold and italic text. It also shows HTML code formatting. + + Input Output 0 false 1 true + + [__@value@ /(input)/__]: Input value + + __returns:__ Boolean result + +__C declaration:__ @html_example@ + +__defined at:__ @documentation\/doxygen_docs.h:148:6@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_html_example@ +-} +html_example :: CInt -> IO CBool {-| Function with HTML formatting @@ -1559,8 +1664,62 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_html_example@ -} -foreign import ccall safe "hs_bindgen_9b7f6745401b4652" html_example :: CInt -> - IO CBool +html_example = fromBaseForeignType html_example_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_825411dc114e599b" list_example_base :: BaseForeignType (Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> + IO CBool) +{-| + + Function with lists and special formatting + + This function demonstrates: + + * Bullet point lists + + * Nested list item 1 + + * Nested list item 2 + + * Multiple items + + * Nested formatting + + Numbered list: + + 1. First @item@ + + 1. item + + 2. Second __item__ + + 3. Third item + + Other numbered list: + + 1. A + + 2. B + + 3. C + + [__@items@ /(input)/__]: Array of items + + [__@count@ /(input)/__]: Number of items + + __returns:__ Success status + +__C declaration:__ @list_example@ + +__defined at:__ @documentation\/doxygen_docs.h:174:6@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_list_example@ +-} +list_example :: Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> IO CBool {-| Function with lists and special formatting @@ -1609,9 +1768,34 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_list_example@ -} -foreign import ccall safe "hs_bindgen_825411dc114e599b" list_example :: Ptr (Ptr CChar) -> - HsBindgen.Runtime.Prelude.CSize -> - IO CBool +list_example = fromBaseForeignType list_example_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_17264dcff7e9b698" dangerous_function_base :: BaseForeignType (Ptr Void -> + IO (Ptr Void)) +{-| + + Function with warnings and notes + + __/WARNING:/__ This function may cause side effects + + __Note:__ Use with caution in multithreaded environments + + __see:__ related_function() for similar functionality + + [__@ptr@ /(input)/__]: Pointer to data + + __returns:__ Modified pointer + +__C declaration:__ @dangerous_function@ + +__defined at:__ @documentation\/doxygen_docs.h:186:7@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_dangerous_function@ +-} +dangerous_function :: Ptr Void -> IO (Ptr Void) {-| Function with warnings and notes @@ -1634,8 +1818,34 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_dangerous_function@ -} -foreign import ccall safe "hs_bindgen_17264dcff7e9b698" dangerous_function :: Ptr Void -> - IO (Ptr Void) +dangerous_function = fromBaseForeignType dangerous_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c8ca619ec2e70d8d" detailed_return_codes_base :: BaseForeignType (Ptr CChar -> + IO CInt) +{-| + + Function with return value details + + [__@input@ /(input)/__]: Input string + + __returns:__ 0 Success + + __returns:__ -1 Invalid input + + __returns:__ -2 Memory allocation failed + + __returns:__ -3 Processing error + +__C declaration:__ @detailed_return_codes@ + +__defined at:__ @documentation\/doxygen_docs.h:197:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_detailed_return_codes@ +-} +detailed_return_codes :: Ptr CChar -> IO CInt {-| Function with return value details @@ -1658,8 +1868,30 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_detailed_return_codes@ -} -foreign import ccall safe "hs_bindgen_c8ca619ec2e70d8d" detailed_return_codes :: Ptr CChar -> - IO CInt +detailed_return_codes = fromBaseForeignType detailed_return_codes_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_25e1070e2ce10048" old_function_base :: BaseForeignType (CInt -> + IO CInt) +{-| + + Function with deprecated annotation + + __deprecated:__ Use new_function() instead + + [__@old_param@ /(input)/__]: Legacy parameter + + __returns:__ Legacy result + +__C declaration:__ @old_function@ + +__defined at:__ @documentation\/doxygen_docs.h:206:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_old_function@ +-} +old_function :: CInt -> IO CInt {-| Function with deprecated annotation @@ -1678,8 +1910,30 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_old_function@ -} -foreign import ccall safe "hs_bindgen_25e1070e2ce10048" old_function :: CInt -> - IO CInt +old_function = fromBaseForeignType old_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a9eeeb09808e71cc" versioned_function_base :: BaseForeignType (CInt -> + IO CInt) +{-| + + Function with version information + + @since: 1.0 + + [__@data@ /(input)/__]: Input data + + __returns:__ Processed data + +__C declaration:__ @versioned_function@ + +__defined at:__ @documentation\/doxygen_docs.h:216:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_versioned_function@ +-} +versioned_function :: CInt -> IO CInt {-| Function with version information @@ -1698,8 +1952,32 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_versioned_function@ -} -foreign import ccall safe "hs_bindgen_a9eeeb09808e71cc" versioned_function :: CInt -> - IO CInt +versioned_function = fromBaseForeignType versioned_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0c0057f1700372a7" process_buffer_base :: BaseForeignType (Ptr CChar -> + HsBindgen.Runtime.Prelude.CSize -> + IO CInt) +{-| + + Static array parameter + + [__@buffer@ /(input)/__]: Buffer with minimum size + + [__@size@ /(input)/__]: Actual buffer size + + __returns:__ Number of bytes written + +__C declaration:__ @process_buffer@ + +__defined at:__ @documentation\/doxygen_docs.h:332:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_buffer@ +-} +process_buffer :: Ptr CChar -> + HsBindgen.Runtime.Prelude.CSize -> IO CInt {-| Static array parameter @@ -1718,9 +1996,13 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_buffer@ -} -foreign import ccall safe "hs_bindgen_0c0057f1700372a7" process_buffer :: Ptr CChar -> - HsBindgen.Runtime.Prelude.CSize -> - IO CInt +process_buffer = fromBaseForeignType process_buffer_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_294db77671f95524" my_memcpy_base :: BaseForeignType (Ptr Void -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> + IO (Ptr Void)) {-| Function with restrict pointers @@ -1741,28 +2023,73 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_my_memcpy@ -} -foreign import ccall safe "hs_bindgen_294db77671f95524" my_memcpy :: Ptr Void -> - Ptr Void -> - HsBindgen.Runtime.Prelude.CSize -> - IO (Ptr Void) +my_memcpy :: Ptr Void -> + Ptr Void -> HsBindgen.Runtime.Prelude.CSize -> IO (Ptr Void) {-| - Inline function + Function with restrict pointers - [__@x@ /(input)/__]: Input value + [__@dest@ /(input)/__]: Destination buffer (restrict) - __returns:__ Doubled value + [__@src@ /(input)/__]: Source buffer (restrict) -__C declaration:__ @double_value@ + [__@n@ /(input)/__]: Number of bytes -__defined at:__ @documentation\/doxygen_docs.h:350:19@ + __returns:__ Destination pointer + +__C declaration:__ @my_memcpy@ + +__defined at:__ @documentation\/doxygen_docs.h:342:7@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_my_memcpy@ +-} +my_memcpy = fromBaseForeignType my_memcpy_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f5bc63a9952c2618" double_value_base :: BaseForeignType (CInt -> + IO CInt) +{-| + + Inline function + + [__@x@ /(input)/__]: Input value + + __returns:__ Doubled value + +__C declaration:__ @double_value@ + +__defined at:__ @documentation\/doxygen_docs.h:350:19@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_double_value@ +-} +double_value :: CInt -> IO CInt +{-| + + Inline function + + [__@x@ /(input)/__]: Input value + + __returns:__ Doubled value + +__C declaration:__ @double_value@ + +__defined at:__ @documentation\/doxygen_docs.h:350:19@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_double_value@ -} -foreign import ccall safe "hs_bindgen_f5bc63a9952c2618" double_value :: CInt -> - IO CInt +double_value = fromBaseForeignType double_value_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c4e7e99dba20204d" complex_function_base :: BaseForeignType (Ptr Config_t -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + HsBindgen.Runtime.Prelude.CSize -> + IO Status_code_t) {-| Function with complex documentation @@ -1836,10 +2163,100 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_complex_function@ -} -foreign import ccall safe "hs_bindgen_c4e7e99dba20204d" complex_function :: Ptr Config_t -> - Ptr HsBindgen.Runtime.Prelude.Word8 -> - HsBindgen.Runtime.Prelude.CSize -> - IO Status_code_t +complex_function :: Ptr Config_t -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + HsBindgen.Runtime.Prelude.CSize -> IO Status_code_t +{-| + + Function with complex documentation + + This function demonstrates multiple documentation features: + + __Description:__ + + Performs complex data processing with multiple steps. + + __Algorithm:__ + + 10. Validate input parameters + + 200. Allocate temporary buffers + + 3000. Process data in chunks + + 41235. Clean up resources + + __Algorithm2:__ + + * Validate input parameters + + * Allocate temporary buffers + + * Process data in chunks + + * Clean up resources + + __Example:__ + + @ + config_t cfg = { + .id = 1, + .name = "test", + .flags = 0, + .callback = my_callback, + .user_data = NULL + }; + + status_code_t result = complex_function(&cfg, data, size); + if (result != STATUS_OK) { + handle_error(result); + } + @ + + [__@config@ /(input)/__]: Configuration structure (see 'Config_t' ) + + [__@data@ /(input)/__]: Input data buffer + + [__@size@ /(input)/__]: Size of input data + + __returns:__ Status code indicating success or failure + + __pre condition:__ config must not be NULL + + __pre condition:__ data must not be NULL if size > 0 + + __post condition:__ Output data is written to config->user_data + + __/WARNING:/__ May return NULL if memory allocation fails + + __/WARNING:/__ Sets errno to EINVAL if parameters are invalid + +__C declaration:__ @complex_function@ + +__defined at:__ @documentation\/doxygen_docs.h:423:15@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_complex_function@ +-} +complex_function = fromBaseForeignType complex_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_935f2aead358d9ef" hash_base :: BaseForeignType (Ptr CChar -> + IO CInt) +{-| + + Marked @__attribute((pure))__@ + +__C declaration:__ @hash@ + +__defined at:__ @documentation\/doxygen_docs.h:427:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_hash@ +-} +hash :: Ptr CChar -> IO CInt {-| Marked @__attribute((pure))__@ @@ -1852,8 +2269,20 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_hash@ -} -foreign import ccall safe "hs_bindgen_935f2aead358d9ef" hash :: Ptr CChar -> - IO CInt +hash = fromBaseForeignType hash_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_39fef54c23d4e1ee" square_base :: BaseForeignType (CInt -> + CInt) +{-| __C declaration:__ @square@ + + __defined at:__ @documentation\/doxygen_docs.h:429:5@ + + __exported by:__ @documentation\/doxygen_docs.h@ + + __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_square@ +-} +square :: CInt -> CInt {-| __C declaration:__ @square@ __defined at:__ @documentation\/doxygen_docs.h:429:5@ @@ -1862,8 +2291,13 @@ foreign import ccall safe "hs_bindgen_935f2aead358d9ef" hash :: Ptr CChar -> __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_square@ -} -foreign import ccall safe "hs_bindgen_39fef54c23d4e1ee" square :: CInt -> - CInt +square = fromBaseForeignType square_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e6085a910ba41ecb" process_data_base :: BaseForeignType (Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.CSize -> + IO CInt) {-| Function with detailed parameter documentation @@ -1886,10 +2320,36 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_data@ -} -foreign import ccall safe "hs_bindgen_e6085a910ba41ecb" process_data :: Ptr HsBindgen.Runtime.Prelude.Word8 -> - Ptr HsBindgen.Runtime.Prelude.Word8 -> - Ptr HsBindgen.Runtime.Prelude.CSize -> - IO CInt +process_data :: Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.CSize -> IO CInt +{-| + + Function with detailed parameter documentation + + This function shows different parameter directions and types. + + [__@input_data@ /(input)/__]: Input data buffer + + [__@output_data@ /(output)/__]: Output data buffer + + [__@size@ /(input,output)/__]: Size of data, updated on return + + __returns:__ Status code (0 = success, -1 = error) + +__C declaration:__ @process_data@ + +__defined at:__ @documentation\/doxygen_docs.h:105:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_data@ +-} +process_data = fromBaseForeignType process_data_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c27e893aea0b0a77" process_file_base :: BaseForeignType (Ptr CChar -> + IO CBool) {-| Function with inline commands and formatting @@ -1908,8 +2368,57 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_file@ -} -foreign import ccall safe "hs_bindgen_c27e893aea0b0a77" process_file :: Ptr CChar -> - IO CBool +process_file :: Ptr CChar -> IO CBool +{-| + + Function with inline commands and formatting + + This function uses @inline@ @code@ formatting and __bold__ text. It also demonstrates /emphasized/ text. + + [__@filename@ /(input)/__]: The @char*@ filename to process + + __returns:__ @true@ if successful, @false@ otherwise + +__C declaration:__ @process_file@ + +__defined at:__ @documentation\/doxygen_docs.h:116:6@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_file@ +-} +process_file = fromBaseForeignType process_file_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bc1b0e25a72f4ec0" calculate_value_base :: BaseForeignType (CInt -> + CInt -> + IO CInt) +{-| + + Function with verbatim code blocks + + Example usage: + + @ + int result = calculate_value(10, 20); + printf("Result: %d@n", result); + @ + + [__@base@ /(input)/__]: Base value + + [__@multiplier@ /(input)/__]: Multiplier value + + __returns:__ Calculated result + +__C declaration:__ @calculate_value@ + +__defined at:__ @documentation\/doxygen_docs.h:131:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_calculate_value@ +-} +calculate_value :: CInt -> CInt -> IO CInt {-| Function with verbatim code blocks @@ -1935,8 +2444,11 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_calculate_value@ -} -foreign import ccall safe "hs_bindgen_bc1b0e25a72f4ec0" calculate_value :: CInt -> - CInt -> IO CInt +calculate_value = fromBaseForeignType calculate_value_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_09abc3cb74562964" html_example_base :: BaseForeignType (CInt -> + IO CBool) {-| Function with HTML formatting @@ -1957,8 +2469,83 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_html_example@ -} -foreign import ccall safe "hs_bindgen_09abc3cb74562964" html_example :: CInt -> - IO CBool +html_example :: CInt -> IO CBool +{-| + + Function with HTML formatting + + This function demonstrates HTML bold and italic text. It also shows HTML code formatting. + + Input Output 0 false 1 true + + [__@value@ /(input)/__]: Input value + + __returns:__ Boolean result + +__C declaration:__ @html_example@ + +__defined at:__ @documentation\/doxygen_docs.h:148:6@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_html_example@ +-} +html_example = fromBaseForeignType html_example_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_47cba1a95d265f84" list_example_base :: BaseForeignType (Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> + IO CBool) +{-| + + Function with lists and special formatting + + This function demonstrates: + + * Bullet point lists + + * Nested list item 1 + + * Nested list item 2 + + * Multiple items + + * Nested formatting + + Numbered list: + + 1. First @item@ + + 1. item + + 2. Second __item__ + + 3. Third item + + Other numbered list: + + 1. A + + 2. B + + 3. C + + [__@items@ /(input)/__]: Array of items + + [__@count@ /(input)/__]: Number of items + + __returns:__ Success status + +__C declaration:__ @list_example@ + +__defined at:__ @documentation\/doxygen_docs.h:174:6@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_list_example@ +-} +list_example :: Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> IO CBool {-| Function with lists and special formatting @@ -2007,33 +2594,84 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_list_example@ -} -foreign import ccall safe "hs_bindgen_47cba1a95d265f84" list_example :: Ptr (Ptr CChar) -> - HsBindgen.Runtime.Prelude.CSize -> - IO CBool +list_example = fromBaseForeignType list_example_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e065fc013e4eccd6" dangerous_function_base :: BaseForeignType (Ptr Void -> + IO (Ptr Void)) +{-| + + Function with warnings and notes + + __/WARNING:/__ This function may cause side effects + + __Note:__ Use with caution in multithreaded environments + + __see:__ related_function() for similar functionality + + [__@ptr@ /(input)/__]: Pointer to data + + __returns:__ Modified pointer + +__C declaration:__ @dangerous_function@ + +__defined at:__ @documentation\/doxygen_docs.h:186:7@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_dangerous_function@ +-} +dangerous_function :: Ptr Void -> IO (Ptr Void) {-| Function with warnings and notes __/WARNING:/__ This function may cause side effects - __Note:__ Use with caution in multithreaded environments + __Note:__ Use with caution in multithreaded environments + + __see:__ related_function() for similar functionality + + [__@ptr@ /(input)/__]: Pointer to data + + __returns:__ Modified pointer + +__C declaration:__ @dangerous_function@ + +__defined at:__ @documentation\/doxygen_docs.h:186:7@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_dangerous_function@ +-} +dangerous_function = fromBaseForeignType dangerous_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bc4f7e24b2ad4ace" detailed_return_codes_base :: BaseForeignType (Ptr CChar -> + IO CInt) +{-| + + Function with return value details + + [__@input@ /(input)/__]: Input string + + __returns:__ 0 Success - __see:__ related_function() for similar functionality + __returns:__ -1 Invalid input - [__@ptr@ /(input)/__]: Pointer to data + __returns:__ -2 Memory allocation failed - __returns:__ Modified pointer + __returns:__ -3 Processing error -__C declaration:__ @dangerous_function@ +__C declaration:__ @detailed_return_codes@ -__defined at:__ @documentation\/doxygen_docs.h:186:7@ +__defined at:__ @documentation\/doxygen_docs.h:197:5@ __exported by:__ @documentation\/doxygen_docs.h@ -__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_dangerous_function@ +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_detailed_return_codes@ -} -foreign import ccall safe "hs_bindgen_e065fc013e4eccd6" dangerous_function :: Ptr Void -> - IO (Ptr Void) +detailed_return_codes :: Ptr CChar -> IO CInt {-| Function with return value details @@ -2056,8 +2694,30 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_detailed_return_codes@ -} -foreign import ccall safe "hs_bindgen_bc4f7e24b2ad4ace" detailed_return_codes :: Ptr CChar -> - IO CInt +detailed_return_codes = fromBaseForeignType detailed_return_codes_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8deec146389ae8b3" old_function_base :: BaseForeignType (CInt -> + IO CInt) +{-| + + Function with deprecated annotation + + __deprecated:__ Use new_function() instead + + [__@old_param@ /(input)/__]: Legacy parameter + + __returns:__ Legacy result + +__C declaration:__ @old_function@ + +__defined at:__ @documentation\/doxygen_docs.h:206:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_old_function@ +-} +old_function :: CInt -> IO CInt {-| Function with deprecated annotation @@ -2076,8 +2736,30 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_old_function@ -} -foreign import ccall safe "hs_bindgen_8deec146389ae8b3" old_function :: CInt -> - IO CInt +old_function = fromBaseForeignType old_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_da2dcc1473935665" versioned_function_base :: BaseForeignType (CInt -> + IO CInt) +{-| + + Function with version information + + @since: 1.0 + + [__@data@ /(input)/__]: Input data + + __returns:__ Processed data + +__C declaration:__ @versioned_function@ + +__defined at:__ @documentation\/doxygen_docs.h:216:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_versioned_function@ +-} +versioned_function :: CInt -> IO CInt {-| Function with version information @@ -2096,8 +2778,32 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_versioned_function@ -} -foreign import ccall safe "hs_bindgen_da2dcc1473935665" versioned_function :: CInt -> - IO CInt +versioned_function = fromBaseForeignType versioned_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_97c1191917e6eece" process_buffer_base :: BaseForeignType (Ptr CChar -> + HsBindgen.Runtime.Prelude.CSize -> + IO CInt) +{-| + + Static array parameter + + [__@buffer@ /(input)/__]: Buffer with minimum size + + [__@size@ /(input)/__]: Actual buffer size + + __returns:__ Number of bytes written + +__C declaration:__ @process_buffer@ + +__defined at:__ @documentation\/doxygen_docs.h:332:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_buffer@ +-} +process_buffer :: Ptr CChar -> + HsBindgen.Runtime.Prelude.CSize -> IO CInt {-| Static array parameter @@ -2116,9 +2822,35 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_process_buffer@ -} -foreign import ccall safe "hs_bindgen_97c1191917e6eece" process_buffer :: Ptr CChar -> - HsBindgen.Runtime.Prelude.CSize -> - IO CInt +process_buffer = fromBaseForeignType process_buffer_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_58253bb560dc3eb3" my_memcpy_base :: BaseForeignType (Ptr Void -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> + IO (Ptr Void)) +{-| + + Function with restrict pointers + + [__@dest@ /(input)/__]: Destination buffer (restrict) + + [__@src@ /(input)/__]: Source buffer (restrict) + + [__@n@ /(input)/__]: Number of bytes + + __returns:__ Destination pointer + +__C declaration:__ @my_memcpy@ + +__defined at:__ @documentation\/doxygen_docs.h:342:7@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_my_memcpy@ +-} +my_memcpy :: Ptr Void -> + Ptr Void -> HsBindgen.Runtime.Prelude.CSize -> IO (Ptr Void) {-| Function with restrict pointers @@ -2139,10 +2871,28 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_my_memcpy@ -} -foreign import ccall safe "hs_bindgen_58253bb560dc3eb3" my_memcpy :: Ptr Void -> - Ptr Void -> - HsBindgen.Runtime.Prelude.CSize -> - IO (Ptr Void) +my_memcpy = fromBaseForeignType my_memcpy_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_44dd19b16ee38e5b" double_value_base :: BaseForeignType (CInt -> + IO CInt) +{-| + + Inline function + + [__@x@ /(input)/__]: Input value + + __returns:__ Doubled value + +__C declaration:__ @double_value@ + +__defined at:__ @documentation\/doxygen_docs.h:350:19@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_double_value@ +-} +double_value :: CInt -> IO CInt {-| Inline function @@ -2159,8 +2909,89 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_double_value@ -} -foreign import ccall safe "hs_bindgen_44dd19b16ee38e5b" double_value :: CInt -> - IO CInt +double_value = fromBaseForeignType double_value_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fd6fce7c8d8b2f79" complex_function_base :: BaseForeignType (Ptr Config_t -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + HsBindgen.Runtime.Prelude.CSize -> + IO Status_code_t) +{-| + + Function with complex documentation + + This function demonstrates multiple documentation features: + + __Description:__ + + Performs complex data processing with multiple steps. + + __Algorithm:__ + + 10. Validate input parameters + + 200. Allocate temporary buffers + + 3000. Process data in chunks + + 41235. Clean up resources + + __Algorithm2:__ + + * Validate input parameters + + * Allocate temporary buffers + + * Process data in chunks + + * Clean up resources + + __Example:__ + + @ + config_t cfg = { + .id = 1, + .name = "test", + .flags = 0, + .callback = my_callback, + .user_data = NULL + }; + + status_code_t result = complex_function(&cfg, data, size); + if (result != STATUS_OK) { + handle_error(result); + } + @ + + [__@config@ /(input)/__]: Configuration structure (see 'Config_t' ) + + [__@data@ /(input)/__]: Input data buffer + + [__@size@ /(input)/__]: Size of input data + + __returns:__ Status code indicating success or failure + + __pre condition:__ config must not be NULL + + __pre condition:__ data must not be NULL if size > 0 + + __post condition:__ Output data is written to config->user_data + + __/WARNING:/__ May return NULL if memory allocation fails + + __/WARNING:/__ Sets errno to EINVAL if parameters are invalid + +__C declaration:__ @complex_function@ + +__defined at:__ @documentation\/doxygen_docs.h:423:15@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_complex_function@ +-} +complex_function :: Ptr Config_t -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + HsBindgen.Runtime.Prelude.CSize -> IO Status_code_t {-| Function with complex documentation @@ -2234,10 +3065,24 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_complex_function@ -} -foreign import ccall safe "hs_bindgen_fd6fce7c8d8b2f79" complex_function :: Ptr Config_t -> - Ptr HsBindgen.Runtime.Prelude.Word8 -> - HsBindgen.Runtime.Prelude.CSize -> - IO Status_code_t +complex_function = fromBaseForeignType complex_function_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dd36c8b317ccfcc4" hash_base :: BaseForeignType (Ptr CChar -> + IO CInt) +{-| + + Marked @__attribute((pure))__@ + +__C declaration:__ @hash@ + +__defined at:__ @documentation\/doxygen_docs.h:427:5@ + +__exported by:__ @documentation\/doxygen_docs.h@ + +__unique:__ @test_documentationdoxygen_docs_Example_Unsafe_hash@ +-} +hash :: Ptr CChar -> IO CInt {-| Marked @__attribute((pure))__@ @@ -2250,8 +3095,20 @@ __exported by:__ @documentation\/doxygen_docs.h@ __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_hash@ -} -foreign import ccall safe "hs_bindgen_dd36c8b317ccfcc4" hash :: Ptr CChar -> - IO CInt +hash = fromBaseForeignType hash_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6875e30a7fe8d30a" square_base :: BaseForeignType (CInt -> + CInt) +{-| __C declaration:__ @square@ + + __defined at:__ @documentation\/doxygen_docs.h:429:5@ + + __exported by:__ @documentation\/doxygen_docs.h@ + + __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_square@ +-} +square :: CInt -> CInt {-| __C declaration:__ @square@ __defined at:__ @documentation\/doxygen_docs.h:429:5@ @@ -2260,14 +3117,21 @@ foreign import ccall safe "hs_bindgen_dd36c8b317ccfcc4" hash :: Ptr CChar -> __unique:__ @test_documentationdoxygen_docs_Example_Unsafe_square@ -} -foreign import ccall safe "hs_bindgen_6875e30a7fe8d30a" square :: CInt -> - CInt +square = fromBaseForeignType square_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_00ad1c4db6c865d6" hs_bindgen_00ad1c4db6c865d6_base :: BaseForeignType (IO (FunPtr (Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.CSize -> + IO CInt))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_process_data_ptr@ +-} +hs_bindgen_00ad1c4db6c865d6 :: IO (FunPtr (Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + Ptr HsBindgen.Runtime.Prelude.CSize -> IO CInt)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_process_data_ptr@ -} -foreign import ccall safe "hs_bindgen_00ad1c4db6c865d6" hs_bindgen_00ad1c4db6c865d6 :: IO (FunPtr (Ptr HsBindgen.Runtime.Prelude.Word8 -> - Ptr HsBindgen.Runtime.Prelude.Word8 -> - Ptr HsBindgen.Runtime.Prelude.CSize -> - IO CInt)) +hs_bindgen_00ad1c4db6c865d6 = fromBaseForeignType hs_bindgen_00ad1c4db6c865d6_base {-# NOINLINE process_data_ptr #-} {-| @@ -2313,10 +3177,16 @@ __defined at:__ @documentation\/doxygen_docs.h:105:5@ __exported by:__ @documentation\/doxygen_docs.h@ -} process_data_ptr = unsafePerformIO hs_bindgen_00ad1c4db6c865d6 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_17f9c7a037fa2ddf" hs_bindgen_17f9c7a037fa2ddf_base :: BaseForeignType (IO (FunPtr (Ptr CChar -> + IO CBool))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_process_file_ptr@ +-} +hs_bindgen_17f9c7a037fa2ddf :: IO (FunPtr (Ptr CChar -> IO CBool)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_process_file_ptr@ -} -foreign import ccall safe "hs_bindgen_17f9c7a037fa2ddf" hs_bindgen_17f9c7a037fa2ddf :: IO (FunPtr (Ptr CChar -> - IO CBool)) +hs_bindgen_17f9c7a037fa2ddf = fromBaseForeignType hs_bindgen_17f9c7a037fa2ddf_base {-# NOINLINE process_file_ptr #-} {-| @@ -2352,11 +3222,18 @@ __defined at:__ @documentation\/doxygen_docs.h:116:6@ __exported by:__ @documentation\/doxygen_docs.h@ -} process_file_ptr = unsafePerformIO hs_bindgen_17f9c7a037fa2ddf +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8b08d5b99efae93b" hs_bindgen_8b08d5b99efae93b_base :: BaseForeignType (IO (FunPtr (CInt -> + CInt -> + IO CInt))) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_calculate_value_ptr@ -} -foreign import ccall safe "hs_bindgen_8b08d5b99efae93b" hs_bindgen_8b08d5b99efae93b :: IO (FunPtr (CInt -> - CInt -> - IO CInt)) +hs_bindgen_8b08d5b99efae93b :: IO (FunPtr (CInt -> + CInt -> IO CInt)) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_calculate_value_ptr@ +-} +hs_bindgen_8b08d5b99efae93b = fromBaseForeignType hs_bindgen_8b08d5b99efae93b_base {-# NOINLINE calculate_value_ptr #-} {-| @@ -2406,10 +3283,16 @@ __defined at:__ @documentation\/doxygen_docs.h:131:5@ __exported by:__ @documentation\/doxygen_docs.h@ -} calculate_value_ptr = unsafePerformIO hs_bindgen_8b08d5b99efae93b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bb00e40be97757d6" hs_bindgen_bb00e40be97757d6_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CBool))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_html_example_ptr@ +-} +hs_bindgen_bb00e40be97757d6 :: IO (FunPtr (CInt -> IO CBool)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_html_example_ptr@ -} -foreign import ccall safe "hs_bindgen_bb00e40be97757d6" hs_bindgen_bb00e40be97757d6 :: IO (FunPtr (CInt -> - IO CBool)) +hs_bindgen_bb00e40be97757d6 = fromBaseForeignType hs_bindgen_bb00e40be97757d6_base {-# NOINLINE html_example_ptr #-} {-| @@ -2449,11 +3332,18 @@ __defined at:__ @documentation\/doxygen_docs.h:148:6@ __exported by:__ @documentation\/doxygen_docs.h@ -} html_example_ptr = unsafePerformIO hs_bindgen_bb00e40be97757d6 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e53b2ca51c16f7df" hs_bindgen_e53b2ca51c16f7df_base :: BaseForeignType (IO (FunPtr (Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> + IO CBool))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_list_example_ptr@ +-} +hs_bindgen_e53b2ca51c16f7df :: IO (FunPtr (Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> IO CBool)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_list_example_ptr@ -} -foreign import ccall safe "hs_bindgen_e53b2ca51c16f7df" hs_bindgen_e53b2ca51c16f7df :: IO (FunPtr (Ptr (Ptr CChar) -> - HsBindgen.Runtime.Prelude.CSize -> - IO CBool)) +hs_bindgen_e53b2ca51c16f7df = fromBaseForeignType hs_bindgen_e53b2ca51c16f7df_base {-# NOINLINE list_example_ptr #-} {-| @@ -2550,10 +3440,17 @@ __defined at:__ @documentation\/doxygen_docs.h:174:6@ __exported by:__ @documentation\/doxygen_docs.h@ -} list_example_ptr = unsafePerformIO hs_bindgen_e53b2ca51c16f7df +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6f8fafd779560b0a" hs_bindgen_6f8fafd779560b0a_base :: BaseForeignType (IO (FunPtr (Ptr Void -> + IO (Ptr Void)))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_dangerous_function_ptr@ +-} +hs_bindgen_6f8fafd779560b0a :: IO (FunPtr (Ptr Void -> + IO (Ptr Void))) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_dangerous_function_ptr@ -} -foreign import ccall safe "hs_bindgen_6f8fafd779560b0a" hs_bindgen_6f8fafd779560b0a :: IO (FunPtr (Ptr Void -> - IO (Ptr Void))) +hs_bindgen_6f8fafd779560b0a = fromBaseForeignType hs_bindgen_6f8fafd779560b0a_base {-# NOINLINE dangerous_function_ptr #-} {-| @@ -2597,10 +3494,16 @@ __defined at:__ @documentation\/doxygen_docs.h:186:7@ __exported by:__ @documentation\/doxygen_docs.h@ -} dangerous_function_ptr = unsafePerformIO hs_bindgen_6f8fafd779560b0a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8316611dfa87497d" hs_bindgen_8316611dfa87497d_base :: BaseForeignType (IO (FunPtr (Ptr CChar -> + IO CInt))) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_detailed_return_codes_ptr@ -} -foreign import ccall safe "hs_bindgen_8316611dfa87497d" hs_bindgen_8316611dfa87497d :: IO (FunPtr (Ptr CChar -> - IO CInt)) +hs_bindgen_8316611dfa87497d :: IO (FunPtr (Ptr CChar -> IO CInt)) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_detailed_return_codes_ptr@ +-} +hs_bindgen_8316611dfa87497d = fromBaseForeignType hs_bindgen_8316611dfa87497d_base {-# NOINLINE detailed_return_codes_ptr #-} {-| @@ -2644,10 +3547,16 @@ __defined at:__ @documentation\/doxygen_docs.h:197:5@ __exported by:__ @documentation\/doxygen_docs.h@ -} detailed_return_codes_ptr = unsafePerformIO hs_bindgen_8316611dfa87497d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9658582afd412d05" hs_bindgen_9658582afd412d05_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_old_function_ptr@ +-} +hs_bindgen_9658582afd412d05 :: IO (FunPtr (CInt -> IO CInt)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_old_function_ptr@ -} -foreign import ccall safe "hs_bindgen_9658582afd412d05" hs_bindgen_9658582afd412d05 :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_9658582afd412d05 = fromBaseForeignType hs_bindgen_9658582afd412d05_base {-# NOINLINE old_function_ptr #-} {-| @@ -2683,10 +3592,16 @@ __defined at:__ @documentation\/doxygen_docs.h:206:5@ __exported by:__ @documentation\/doxygen_docs.h@ -} old_function_ptr = unsafePerformIO hs_bindgen_9658582afd412d05 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fed78653b04cad56" hs_bindgen_fed78653b04cad56_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_versioned_function_ptr@ +-} +hs_bindgen_fed78653b04cad56 :: IO (FunPtr (CInt -> IO CInt)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_versioned_function_ptr@ -} -foreign import ccall safe "hs_bindgen_fed78653b04cad56" hs_bindgen_fed78653b04cad56 :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_fed78653b04cad56 = fromBaseForeignType hs_bindgen_fed78653b04cad56_base {-# NOINLINE versioned_function_ptr #-} {-| @@ -2722,12 +3637,20 @@ __defined at:__ @documentation\/doxygen_docs.h:216:5@ __exported by:__ @documentation\/doxygen_docs.h@ -} versioned_function_ptr = unsafePerformIO hs_bindgen_fed78653b04cad56 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_54ecd4981536e33b" hs_bindgen_54ecd4981536e33b_base :: BaseForeignType (IO (FunPtr (ConstantArray 64 + CChar -> + HsBindgen.Runtime.Prelude.CSize -> + IO CInt))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_process_buffer_ptr@ +-} +hs_bindgen_54ecd4981536e33b :: IO (FunPtr (ConstantArray 64 + CChar -> + HsBindgen.Runtime.Prelude.CSize -> IO CInt)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_process_buffer_ptr@ -} -foreign import ccall safe "hs_bindgen_54ecd4981536e33b" hs_bindgen_54ecd4981536e33b :: IO (FunPtr (ConstantArray 64 - CChar -> - HsBindgen.Runtime.Prelude.CSize -> - IO CInt)) +hs_bindgen_54ecd4981536e33b = fromBaseForeignType hs_bindgen_54ecd4981536e33b_base {-# NOINLINE process_buffer_ptr #-} {-| @@ -2764,12 +3687,20 @@ __defined at:__ @documentation\/doxygen_docs.h:332:5@ __exported by:__ @documentation\/doxygen_docs.h@ -} process_buffer_ptr = unsafePerformIO hs_bindgen_54ecd4981536e33b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f3280e35cf2dec18" hs_bindgen_f3280e35cf2dec18_base :: BaseForeignType (IO (FunPtr (Ptr Void -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> + IO (Ptr Void)))) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_my_memcpy_ptr@ -} -foreign import ccall safe "hs_bindgen_f3280e35cf2dec18" hs_bindgen_f3280e35cf2dec18 :: IO (FunPtr (Ptr Void -> - Ptr Void -> - HsBindgen.Runtime.Prelude.CSize -> - IO (Ptr Void))) +hs_bindgen_f3280e35cf2dec18 :: IO (FunPtr (Ptr Void -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> IO (Ptr Void))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_my_memcpy_ptr@ +-} +hs_bindgen_f3280e35cf2dec18 = fromBaseForeignType hs_bindgen_f3280e35cf2dec18_base {-# NOINLINE my_memcpy_ptr #-} {-| @@ -2810,10 +3741,16 @@ __defined at:__ @documentation\/doxygen_docs.h:342:7@ __exported by:__ @documentation\/doxygen_docs.h@ -} my_memcpy_ptr = unsafePerformIO hs_bindgen_f3280e35cf2dec18 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3c5017e63542a732" hs_bindgen_3c5017e63542a732_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_double_value_ptr@ +-} +hs_bindgen_3c5017e63542a732 :: IO (FunPtr (CInt -> IO CInt)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_double_value_ptr@ -} -foreign import ccall safe "hs_bindgen_3c5017e63542a732" hs_bindgen_3c5017e63542a732 :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_3c5017e63542a732 = fromBaseForeignType hs_bindgen_3c5017e63542a732_base {-# NOINLINE double_value_ptr #-} {-| @@ -2845,12 +3782,20 @@ __defined at:__ @documentation\/doxygen_docs.h:350:19@ __exported by:__ @documentation\/doxygen_docs.h@ -} double_value_ptr = unsafePerformIO hs_bindgen_3c5017e63542a732 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5c7ef3361588f78d" hs_bindgen_5c7ef3361588f78d_base :: BaseForeignType (IO (FunPtr (Ptr Config_t -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + HsBindgen.Runtime.Prelude.CSize -> + IO Status_code_t))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_complex_function_ptr@ +-} +hs_bindgen_5c7ef3361588f78d :: IO (FunPtr (Ptr Config_t -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + HsBindgen.Runtime.Prelude.CSize -> IO Status_code_t)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_complex_function_ptr@ -} -foreign import ccall safe "hs_bindgen_5c7ef3361588f78d" hs_bindgen_5c7ef3361588f78d :: IO (FunPtr (Ptr Config_t -> - Ptr HsBindgen.Runtime.Prelude.Word8 -> - HsBindgen.Runtime.Prelude.CSize -> - IO Status_code_t)) +hs_bindgen_5c7ef3361588f78d = fromBaseForeignType hs_bindgen_5c7ef3361588f78d_base {-# NOINLINE complex_function_ptr #-} {-| @@ -2998,10 +3943,16 @@ __defined at:__ @documentation\/doxygen_docs.h:423:15@ __exported by:__ @documentation\/doxygen_docs.h@ -} complex_function_ptr = unsafePerformIO hs_bindgen_5c7ef3361588f78d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c5116c8a533d238c" hs_bindgen_c5116c8a533d238c_base :: BaseForeignType (IO (FunPtr (Ptr CChar -> + IO CInt))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_hash_ptr@ +-} +hs_bindgen_c5116c8a533d238c :: IO (FunPtr (Ptr CChar -> IO CInt)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_hash_ptr@ -} -foreign import ccall safe "hs_bindgen_c5116c8a533d238c" hs_bindgen_c5116c8a533d238c :: IO (FunPtr (Ptr CChar -> - IO CInt)) +hs_bindgen_c5116c8a533d238c = fromBaseForeignType hs_bindgen_c5116c8a533d238c_base {-# NOINLINE hash_ptr #-} {-| __C declaration:__ @hash@ @@ -3017,10 +3968,16 @@ hash_ptr :: FunPtr (Ptr CChar -> IO CInt) __exported by:__ @documentation\/doxygen_docs.h@ -} hash_ptr = unsafePerformIO hs_bindgen_c5116c8a533d238c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f488217ac3b07e44" hs_bindgen_f488217ac3b07e44_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_square_ptr@ -} -foreign import ccall safe "hs_bindgen_f488217ac3b07e44" hs_bindgen_f488217ac3b07e44 :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_f488217ac3b07e44 :: IO (FunPtr (CInt -> IO CInt)) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_square_ptr@ +-} +hs_bindgen_f488217ac3b07e44 = fromBaseForeignType hs_bindgen_f488217ac3b07e44_base {-# NOINLINE square_ptr #-} {-| __C declaration:__ @square@ @@ -3036,9 +3993,15 @@ square_ptr :: FunPtr (CInt -> IO CInt) __exported by:__ @documentation\/doxygen_docs.h@ -} square_ptr = unsafePerformIO hs_bindgen_f488217ac3b07e44 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a568b76e8feb0427" hs_bindgen_a568b76e8feb0427_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_global_counter_ptr@ +-} +hs_bindgen_a568b76e8feb0427 :: IO (Ptr CInt) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_global_counter_ptr@ -} -foreign import ccall safe "hs_bindgen_a568b76e8feb0427" hs_bindgen_a568b76e8feb0427 :: IO (Ptr CInt) +hs_bindgen_a568b76e8feb0427 = fromBaseForeignType hs_bindgen_a568b76e8feb0427_base {-# NOINLINE global_counter_ptr #-} {-| @@ -3070,9 +4033,15 @@ __defined at:__ @documentation\/doxygen_docs.h:61:12@ __exported by:__ @documentation\/doxygen_docs.h@ -} global_counter_ptr = unsafePerformIO hs_bindgen_a568b76e8feb0427 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dd671052fd43d189" hs_bindgen_dd671052fd43d189_base :: BaseForeignType (IO (Ptr (Ptr CChar))) +{-| __unique:__ @test_documentationdoxygen_docs_Example_get_version_string_ptr@ +-} +hs_bindgen_dd671052fd43d189 :: IO (Ptr (Ptr CChar)) {-| __unique:__ @test_documentationdoxygen_docs_Example_get_version_string_ptr@ -} -foreign import ccall safe "hs_bindgen_dd671052fd43d189" hs_bindgen_dd671052fd43d189 :: IO (Ptr (Ptr CChar)) +hs_bindgen_dd671052fd43d189 = fromBaseForeignType hs_bindgen_dd671052fd43d189_base {-# NOINLINE version_string_ptr #-} {-| diff --git a/hs-bindgen/fixtures/edge-cases/adios/Example/FunPtr.hs b/hs-bindgen/fixtures/edge-cases/adios/Example/FunPtr.hs index 445bc201c..3e60c7117 100644 --- a/hs-bindgen/fixtures/edge-cases/adios/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/edge-cases/adios/Example/FunPtr.hs @@ -7,6 +7,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -32,10 +33,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_edd8d9690af73a14" hs_bindgen_edd8d9690af73a14_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesadios_Example_get_ϒ_ptr@ -} -foreign import ccall unsafe "hs_bindgen_edd8d9690af73a14" hs_bindgen_edd8d9690af73a14 :: +hs_bindgen_edd8d9690af73a14 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_edd8d9690af73a14 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_edd8d9690af73a14_base {-# NOINLINE cϒ_ptr #-} @@ -49,10 +57,17 @@ cϒ_ptr :: Ptr.FunPtr (IO ()) cϒ_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_edd8d9690af73a14 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_53e9160a3156c412" hs_bindgen_53e9160a3156c412_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesadios_Example_get_拜拜_ptr@ -} -foreign import ccall unsafe "hs_bindgen_53e9160a3156c412" hs_bindgen_53e9160a3156c412 :: +hs_bindgen_53e9160a3156c412 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_53e9160a3156c412 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_53e9160a3156c412_base {-# NOINLINE 拜拜_ptr #-} @@ -66,10 +81,17 @@ foreign import ccall unsafe "hs_bindgen_53e9160a3156c412" hs_bindgen_53e9160a315 拜拜_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_53e9160a3156c412 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d263c2ebc6beb189" hs_bindgen_d263c2ebc6beb189_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesadios_Example_get_Say拜拜_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d263c2ebc6beb189" hs_bindgen_d263c2ebc6beb189 :: +hs_bindgen_d263c2ebc6beb189 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_d263c2ebc6beb189 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d263c2ebc6beb189_base {-# NOINLINE say拜拜_ptr #-} diff --git a/hs-bindgen/fixtures/edge-cases/adios/Example/Global.hs b/hs-bindgen/fixtures/edge-cases/adios/Example/Global.hs index 36dd9a316..7a67a90e0 100644 --- a/hs-bindgen/fixtures/edge-cases/adios/Example/Global.hs +++ b/hs-bindgen/fixtures/edge-cases/adios/Example/Global.hs @@ -9,6 +9,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -28,10 +29,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a5a7bbe6b8c53539" hs_bindgen_a5a7bbe6b8c53539_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_edgecasesadios_Example_get_ϒϒ_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a5a7bbe6b8c53539" hs_bindgen_a5a7bbe6b8c53539 :: +hs_bindgen_a5a7bbe6b8c53539 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_a5a7bbe6b8c53539 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a5a7bbe6b8c53539_base {-# NOINLINE cϒϒ_ptr #-} @@ -45,10 +53,17 @@ cϒϒ_ptr :: Ptr.Ptr FC.CInt cϒϒ_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a5a7bbe6b8c53539 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_31d6bde39787c8b8" hs_bindgen_31d6bde39787c8b8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_edgecasesadios_Example_get_ϒϒϒ_ptr@ -} -foreign import ccall unsafe "hs_bindgen_31d6bde39787c8b8" hs_bindgen_31d6bde39787c8b8 :: +hs_bindgen_31d6bde39787c8b8 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_31d6bde39787c8b8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_31d6bde39787c8b8_base {-# NOINLINE cϒϒϒ_ptr #-} diff --git a/hs-bindgen/fixtures/edge-cases/adios/Example/Safe.hs b/hs-bindgen/fixtures/edge-cases/adios/Example/Safe.hs index 6b722ee77..2f74cc865 100644 --- a/hs-bindgen/fixtures/edge-cases/adios/Example/Safe.hs +++ b/hs-bindgen/fixtures/edge-cases/adios/Example/Safe.hs @@ -5,6 +5,7 @@ module Example.Safe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -24,6 +25,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2010521804ef9a6e" cϒ_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @ϒ@ __defined at:__ @edge-cases\/adios.h:18:6@ @@ -32,8 +38,15 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesadios_Example_Safe_ϒ@ -} -foreign import ccall safe "hs_bindgen_2010521804ef9a6e" cϒ :: +cϒ :: IO () +cϒ = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType cϒ_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3bc3e53cc82c9580" 拜拜_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @拜拜@ @@ -43,8 +56,15 @@ foreign import ccall safe "hs_bindgen_2010521804ef9a6e" cϒ :: __unique:__ @test_edgecasesadios_Example_Safe_拜拜@ -} -foreign import ccall safe "hs_bindgen_3bc3e53cc82c9580" 拜拜 :: +拜拜 :: IO () +拜拜 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType 拜拜_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ad8eb47027b2d49d" say拜拜_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @Say拜拜@ @@ -54,5 +74,7 @@ foreign import ccall safe "hs_bindgen_3bc3e53cc82c9580" 拜拜 :: __unique:__ @test_edgecasesadios_Example_Safe_Say拜拜@ -} -foreign import ccall safe "hs_bindgen_ad8eb47027b2d49d" say拜拜 :: +say拜拜 :: IO () +say拜拜 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType say拜拜_base diff --git a/hs-bindgen/fixtures/edge-cases/adios/Example/Unsafe.hs b/hs-bindgen/fixtures/edge-cases/adios/Example/Unsafe.hs index 4be6b400a..81ae91c49 100644 --- a/hs-bindgen/fixtures/edge-cases/adios/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/edge-cases/adios/Example/Unsafe.hs @@ -5,6 +5,7 @@ module Example.Unsafe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -24,6 +25,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1814d14d59d9daf7" cϒ_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @ϒ@ __defined at:__ @edge-cases\/adios.h:18:6@ @@ -32,8 +38,15 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesadios_Example_Unsafe_ϒ@ -} -foreign import ccall unsafe "hs_bindgen_1814d14d59d9daf7" cϒ :: +cϒ :: IO () +cϒ = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType cϒ_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c1ab9527e537714b" 拜拜_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @拜拜@ @@ -43,8 +56,15 @@ foreign import ccall unsafe "hs_bindgen_1814d14d59d9daf7" cϒ :: __unique:__ @test_edgecasesadios_Example_Unsafe_拜拜@ -} -foreign import ccall unsafe "hs_bindgen_c1ab9527e537714b" 拜拜 :: +拜拜 :: IO () +拜拜 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType 拜拜_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d532055af9051fad" say拜拜_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @Say拜拜@ @@ -54,5 +74,7 @@ foreign import ccall unsafe "hs_bindgen_c1ab9527e537714b" 拜拜 :: __unique:__ @test_edgecasesadios_Example_Unsafe_Say拜拜@ -} -foreign import ccall unsafe "hs_bindgen_d532055af9051fad" say拜拜 :: +say拜拜 :: IO () +say拜拜 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType say拜拜_base diff --git a/hs-bindgen/fixtures/edge-cases/adios/th.txt b/hs-bindgen/fixtures/edge-cases/adios/th.txt index eb35dedba..412282723 100644 --- a/hs-bindgen/fixtures/edge-cases/adios/th.txt +++ b/hs-bindgen/fixtures/edge-cases/adios/th.txt @@ -116,6 +116,18 @@ instance TyEq ty (CFieldType C数字 "un_C\25968\23383") => instance HasCField C数字 "un_C\25968\23383" where type CFieldType C数字 "un_C\25968\23383" = CInt offset# = \_ -> \_ -> 0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2010521804ef9a6e" cϒ_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @ϒ@ + + __defined at:__ @edge-cases\/adios.h:18:6@ + + __exported by:__ @edge-cases\/adios.h@ + + __unique:__ @test_edgecasesadios_Example_Unsafe_ϒ@ +-} +cϒ :: IO Unit {-| __C declaration:__ @ϒ@ __defined at:__ @edge-cases\/adios.h:18:6@ @@ -124,7 +136,19 @@ instance HasCField C数字 "un_C\25968\23383" __unique:__ @test_edgecasesadios_Example_Unsafe_ϒ@ -} -foreign import ccall safe "hs_bindgen_2010521804ef9a6e" cϒ :: IO Unit +cϒ = fromBaseForeignType cϒ_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3bc3e53cc82c9580" 拜拜_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @拜拜@ + + __defined at:__ @edge-cases\/adios.h:27:6@ + + __exported by:__ @edge-cases\/adios.h@ + + __unique:__ @test_edgecasesadios_Example_Unsafe_拜拜@ +-} +拜拜 :: IO Unit {-| __C declaration:__ @拜拜@ __defined at:__ @edge-cases\/adios.h:27:6@ @@ -133,7 +157,19 @@ foreign import ccall safe "hs_bindgen_2010521804ef9a6e" cϒ :: IO Unit __unique:__ @test_edgecasesadios_Example_Unsafe_拜拜@ -} -foreign import ccall safe "hs_bindgen_3bc3e53cc82c9580" 拜拜 :: IO Unit +拜拜 = fromBaseForeignType 拜拜_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ad8eb47027b2d49d" say拜拜_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @Say拜拜@ + + __defined at:__ @edge-cases\/adios.h:31:6@ + + __exported by:__ @edge-cases\/adios.h@ + + __unique:__ @test_edgecasesadios_Example_Unsafe_Say拜拜@ +-} +say拜拜 :: IO Unit {-| __C declaration:__ @Say拜拜@ __defined at:__ @edge-cases\/adios.h:31:6@ @@ -142,7 +178,10 @@ foreign import ccall safe "hs_bindgen_3bc3e53cc82c9580" 拜拜 :: IO Unit __unique:__ @test_edgecasesadios_Example_Unsafe_Say拜拜@ -} -foreign import ccall safe "hs_bindgen_ad8eb47027b2d49d" say拜拜 :: IO Unit +say拜拜 = fromBaseForeignType say拜拜_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1814d14d59d9daf7" cϒ_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @ϒ@ __defined at:__ @edge-cases\/adios.h:18:6@ @@ -151,7 +190,19 @@ foreign import ccall safe "hs_bindgen_ad8eb47027b2d49d" say拜拜 :: IO Unit __unique:__ @test_edgecasesadios_Example_Unsafe_ϒ@ -} -foreign import ccall safe "hs_bindgen_1814d14d59d9daf7" cϒ :: IO Unit +cϒ :: IO Unit +{-| __C declaration:__ @ϒ@ + + __defined at:__ @edge-cases\/adios.h:18:6@ + + __exported by:__ @edge-cases\/adios.h@ + + __unique:__ @test_edgecasesadios_Example_Unsafe_ϒ@ +-} +cϒ = fromBaseForeignType cϒ_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c1ab9527e537714b" 拜拜_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @拜拜@ __defined at:__ @edge-cases\/adios.h:27:6@ @@ -160,7 +211,28 @@ foreign import ccall safe "hs_bindgen_1814d14d59d9daf7" cϒ :: IO Unit __unique:__ @test_edgecasesadios_Example_Unsafe_拜拜@ -} -foreign import ccall safe "hs_bindgen_c1ab9527e537714b" 拜拜 :: IO Unit +拜拜 :: IO Unit +{-| __C declaration:__ @拜拜@ + + __defined at:__ @edge-cases\/adios.h:27:6@ + + __exported by:__ @edge-cases\/adios.h@ + + __unique:__ @test_edgecasesadios_Example_Unsafe_拜拜@ +-} +拜拜 = fromBaseForeignType 拜拜_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d532055af9051fad" say拜拜_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @Say拜拜@ + + __defined at:__ @edge-cases\/adios.h:31:6@ + + __exported by:__ @edge-cases\/adios.h@ + + __unique:__ @test_edgecasesadios_Example_Unsafe_Say拜拜@ +-} +say拜拜 :: IO Unit {-| __C declaration:__ @Say拜拜@ __defined at:__ @edge-cases\/adios.h:31:6@ @@ -169,10 +241,16 @@ foreign import ccall safe "hs_bindgen_c1ab9527e537714b" 拜拜 :: IO Unit __unique:__ @test_edgecasesadios_Example_Unsafe_Say拜拜@ -} -foreign import ccall safe "hs_bindgen_d532055af9051fad" say拜拜 :: IO Unit +say拜拜 = fromBaseForeignType say拜拜_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_edd8d9690af73a14" hs_bindgen_edd8d9690af73a14_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesadios_Example_get_ϒ_ptr@ +-} +hs_bindgen_edd8d9690af73a14 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesadios_Example_get_ϒ_ptr@ -} -foreign import ccall safe "hs_bindgen_edd8d9690af73a14" hs_bindgen_edd8d9690af73a14 :: IO (FunPtr (IO Unit)) +hs_bindgen_edd8d9690af73a14 = fromBaseForeignType hs_bindgen_edd8d9690af73a14_base {-# NOINLINE cϒ_ptr #-} {-| __C declaration:__ @ϒ@ @@ -188,9 +266,15 @@ cϒ_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/adios.h@ -} cϒ_ptr = unsafePerformIO hs_bindgen_edd8d9690af73a14 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_53e9160a3156c412" hs_bindgen_53e9160a3156c412_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesadios_Example_get_拜拜_ptr@ +-} +hs_bindgen_53e9160a3156c412 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesadios_Example_get_拜拜_ptr@ -} -foreign import ccall safe "hs_bindgen_53e9160a3156c412" hs_bindgen_53e9160a3156c412 :: IO (FunPtr (IO Unit)) +hs_bindgen_53e9160a3156c412 = fromBaseForeignType hs_bindgen_53e9160a3156c412_base {-# NOINLINE 拜拜_ptr #-} {-| __C declaration:__ @拜拜@ @@ -206,9 +290,15 @@ foreign import ccall safe "hs_bindgen_53e9160a3156c412" hs_bindgen_53e9160a3156c __exported by:__ @edge-cases\/adios.h@ -} 拜拜_ptr = unsafePerformIO hs_bindgen_53e9160a3156c412 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d263c2ebc6beb189" hs_bindgen_d263c2ebc6beb189_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_edgecasesadios_Example_get_Say拜拜_ptr@ -} -foreign import ccall safe "hs_bindgen_d263c2ebc6beb189" hs_bindgen_d263c2ebc6beb189 :: IO (FunPtr (IO Unit)) +hs_bindgen_d263c2ebc6beb189 :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_edgecasesadios_Example_get_Say拜拜_ptr@ +-} +hs_bindgen_d263c2ebc6beb189 = fromBaseForeignType hs_bindgen_d263c2ebc6beb189_base {-# NOINLINE say拜拜_ptr #-} {-| __C declaration:__ @Say拜拜@ @@ -224,9 +314,15 @@ say拜拜_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/adios.h@ -} say拜拜_ptr = unsafePerformIO hs_bindgen_d263c2ebc6beb189 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a5a7bbe6b8c53539" hs_bindgen_a5a7bbe6b8c53539_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_edgecasesadios_Example_get_ϒϒ_ptr@ +-} +hs_bindgen_a5a7bbe6b8c53539 :: IO (Ptr CInt) {-| __unique:__ @test_edgecasesadios_Example_get_ϒϒ_ptr@ -} -foreign import ccall safe "hs_bindgen_a5a7bbe6b8c53539" hs_bindgen_a5a7bbe6b8c53539 :: IO (Ptr CInt) +hs_bindgen_a5a7bbe6b8c53539 = fromBaseForeignType hs_bindgen_a5a7bbe6b8c53539_base {-# NOINLINE cϒϒ_ptr #-} {-| __C declaration:__ @ϒϒ@ @@ -242,9 +338,15 @@ cϒϒ_ptr :: Ptr CInt __exported by:__ @edge-cases\/adios.h@ -} cϒϒ_ptr = unsafePerformIO hs_bindgen_a5a7bbe6b8c53539 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_31d6bde39787c8b8" hs_bindgen_31d6bde39787c8b8_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_edgecasesadios_Example_get_ϒϒϒ_ptr@ +-} +hs_bindgen_31d6bde39787c8b8 :: IO (Ptr CInt) {-| __unique:__ @test_edgecasesadios_Example_get_ϒϒϒ_ptr@ -} -foreign import ccall safe "hs_bindgen_31d6bde39787c8b8" hs_bindgen_31d6bde39787c8b8 :: IO (Ptr CInt) +hs_bindgen_31d6bde39787c8b8 = fromBaseForeignType hs_bindgen_31d6bde39787c8b8_base {-# NOINLINE cϒϒϒ_ptr #-} {-| __C declaration:__ @ϒϒϒ@ diff --git a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/FunPtr.hs b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/FunPtr.hs index 650dff6a8..27edc45d0 100644 --- a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/FunPtr.hs @@ -7,6 +7,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude import Example @@ -26,10 +27,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a045a07b1f36239d" hs_bindgen_a045a07b1f36239d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr A_type_t) -> HsBindgen.Runtime.Prelude.Word32 -> (HsBindgen.Runtime.IncompleteArray.IncompleteArray HsBindgen.Runtime.Prelude.Word8) -> IO HsBindgen.Runtime.Prelude.Int32))) + {-| __unique:__ @test_edgecasesdistilled_lib_1_Example_get_some_fun_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a045a07b1f36239d" hs_bindgen_a045a07b1f36239d :: +hs_bindgen_a045a07b1f36239d :: IO (Ptr.FunPtr ((Ptr.Ptr A_type_t) -> HsBindgen.Runtime.Prelude.Word32 -> (HsBindgen.Runtime.IncompleteArray.IncompleteArray HsBindgen.Runtime.Prelude.Word8) -> IO HsBindgen.Runtime.Prelude.Int32)) +hs_bindgen_a045a07b1f36239d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a045a07b1f36239d_base {-# NOINLINE some_fun_ptr #-} diff --git a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Global.hs b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Global.hs index bcb733a5e..8836f026a 100644 --- a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Global.hs +++ b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Global.hs @@ -7,6 +7,7 @@ module Example.Global where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -21,10 +22,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9b325860ee78839e" hs_bindgen_9b325860ee78839e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Var_t)) + {-| __unique:__ @test_edgecasesdistilled_lib_1_Example_get_v_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9b325860ee78839e" hs_bindgen_9b325860ee78839e :: +hs_bindgen_9b325860ee78839e :: IO (Ptr.Ptr Var_t) +hs_bindgen_9b325860ee78839e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9b325860ee78839e_base {-# NOINLINE v_ptr #-} diff --git a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Safe.hs b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Safe.hs index 522397bf4..648c00ed3 100644 --- a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Safe.hs +++ b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Safe.hs @@ -6,6 +6,7 @@ module Example.Safe where import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -22,6 +23,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_57cb99ed92c001ad" some_fun_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr A_type_t) -> HsBindgen.Runtime.Prelude.Word32 -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> IO HsBindgen.Runtime.Prelude.Int32) + {-| __C declaration:__ @some_fun@ __defined at:__ @edge-cases\/distilled_lib_1.h:72:9@ @@ -30,7 +36,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesdistilled_lib_1_Example_Safe_some_fun@ -} -foreign import ccall safe "hs_bindgen_57cb99ed92c001ad" some_fun :: +some_fun :: Ptr.Ptr A_type_t {- ^ __C declaration:__ @i@ -} @@ -41,3 +47,5 @@ foreign import ccall safe "hs_bindgen_57cb99ed92c001ad" some_fun :: {- ^ __C declaration:__ @k@ -} -> IO HsBindgen.Runtime.Prelude.Int32 +some_fun = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType some_fun_base diff --git a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Unsafe.hs b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Unsafe.hs index 4e5e87e40..15cde3416 100644 --- a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/Example/Unsafe.hs @@ -6,6 +6,7 @@ module Example.Unsafe where import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -22,6 +23,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2a91c367a9380a63" some_fun_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr A_type_t) -> HsBindgen.Runtime.Prelude.Word32 -> (Ptr.Ptr HsBindgen.Runtime.Prelude.Word8) -> IO HsBindgen.Runtime.Prelude.Int32) + {-| __C declaration:__ @some_fun@ __defined at:__ @edge-cases\/distilled_lib_1.h:72:9@ @@ -30,7 +36,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesdistilled_lib_1_Example_Unsafe_some_fun@ -} -foreign import ccall unsafe "hs_bindgen_2a91c367a9380a63" some_fun :: +some_fun :: Ptr.Ptr A_type_t {- ^ __C declaration:__ @i@ -} @@ -41,3 +47,5 @@ foreign import ccall unsafe "hs_bindgen_2a91c367a9380a63" some_fun :: {- ^ __C declaration:__ @k@ -} -> IO HsBindgen.Runtime.Prelude.Int32 +some_fun = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType some_fun_base diff --git a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/th.txt b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/th.txt index a93519df2..e078e627d 100644 --- a/hs-bindgen/fixtures/edge-cases/distilled_lib_1/th.txt +++ b/hs-bindgen/fixtures/edge-cases/distilled_lib_1/th.txt @@ -696,6 +696,39 @@ instance HasCField Callback_t "un_Callback_t" where type CFieldType Callback_t "un_Callback_t" = FunPtr Callback_t_Deref offset# = \_ -> \_ -> 0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_57cb99ed92c001ad" some_fun_base :: BaseForeignType (Ptr A_type_t -> + HsBindgen.Runtime.Prelude.Word32 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + IO HsBindgen.Runtime.Prelude.Int32) +{-| __C declaration:__ @some_fun@ + + __defined at:__ @edge-cases\/distilled_lib_1.h:72:9@ + + __exported by:__ @edge-cases\/distilled_lib_1.h@ + + __unique:__ @test_edgecasesdistilled_lib_1_Example_Unsafe_some_fun@ +-} +some_fun :: Ptr A_type_t -> + HsBindgen.Runtime.Prelude.Word32 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + IO HsBindgen.Runtime.Prelude.Int32 +{-| __C declaration:__ @some_fun@ + + __defined at:__ @edge-cases\/distilled_lib_1.h:72:9@ + + __exported by:__ @edge-cases\/distilled_lib_1.h@ + + __unique:__ @test_edgecasesdistilled_lib_1_Example_Unsafe_some_fun@ +-} +some_fun = fromBaseForeignType some_fun_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2a91c367a9380a63" some_fun_base :: BaseForeignType (Ptr A_type_t -> + HsBindgen.Runtime.Prelude.Word32 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + IO HsBindgen.Runtime.Prelude.Int32) {-| __C declaration:__ @some_fun@ __defined at:__ @edge-cases\/distilled_lib_1.h:72:9@ @@ -704,10 +737,10 @@ instance HasCField Callback_t "un_Callback_t" __unique:__ @test_edgecasesdistilled_lib_1_Example_Unsafe_some_fun@ -} -foreign import ccall safe "hs_bindgen_57cb99ed92c001ad" some_fun :: Ptr A_type_t -> - HsBindgen.Runtime.Prelude.Word32 -> - Ptr HsBindgen.Runtime.Prelude.Word8 -> - IO HsBindgen.Runtime.Prelude.Int32 +some_fun :: Ptr A_type_t -> + HsBindgen.Runtime.Prelude.Word32 -> + Ptr HsBindgen.Runtime.Prelude.Word8 -> + IO HsBindgen.Runtime.Prelude.Int32 {-| __C declaration:__ @some_fun@ __defined at:__ @edge-cases\/distilled_lib_1.h:72:9@ @@ -716,16 +749,22 @@ foreign import ccall safe "hs_bindgen_57cb99ed92c001ad" some_fun :: Ptr A_type_t __unique:__ @test_edgecasesdistilled_lib_1_Example_Unsafe_some_fun@ -} -foreign import ccall safe "hs_bindgen_2a91c367a9380a63" some_fun :: Ptr A_type_t -> - HsBindgen.Runtime.Prelude.Word32 -> - Ptr HsBindgen.Runtime.Prelude.Word8 -> - IO HsBindgen.Runtime.Prelude.Int32 +some_fun = fromBaseForeignType some_fun_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a045a07b1f36239d" hs_bindgen_a045a07b1f36239d_base :: BaseForeignType (IO (FunPtr (Ptr A_type_t -> + HsBindgen.Runtime.Prelude.Word32 -> + IncompleteArray HsBindgen.Runtime.Prelude.Word8 -> + IO HsBindgen.Runtime.Prelude.Int32))) +{-| __unique:__ @test_edgecasesdistilled_lib_1_Example_get_some_fun_ptr@ +-} +hs_bindgen_a045a07b1f36239d :: IO (FunPtr (Ptr A_type_t -> + HsBindgen.Runtime.Prelude.Word32 -> + IncompleteArray HsBindgen.Runtime.Prelude.Word8 -> + IO HsBindgen.Runtime.Prelude.Int32)) {-| __unique:__ @test_edgecasesdistilled_lib_1_Example_get_some_fun_ptr@ -} -foreign import ccall safe "hs_bindgen_a045a07b1f36239d" hs_bindgen_a045a07b1f36239d :: IO (FunPtr (Ptr A_type_t -> - HsBindgen.Runtime.Prelude.Word32 -> - IncompleteArray HsBindgen.Runtime.Prelude.Word8 -> - IO HsBindgen.Runtime.Prelude.Int32)) +hs_bindgen_a045a07b1f36239d = fromBaseForeignType hs_bindgen_a045a07b1f36239d_base {-# NOINLINE some_fun_ptr #-} {-| __C declaration:__ @some_fun@ @@ -744,9 +783,15 @@ some_fun_ptr :: FunPtr (Ptr A_type_t -> __exported by:__ @edge-cases\/distilled_lib_1.h@ -} some_fun_ptr = unsafePerformIO hs_bindgen_a045a07b1f36239d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9b325860ee78839e" hs_bindgen_9b325860ee78839e_base :: BaseForeignType (IO (Ptr Var_t)) +{-| __unique:__ @test_edgecasesdistilled_lib_1_Example_get_v_ptr@ +-} +hs_bindgen_9b325860ee78839e :: IO (Ptr Var_t) {-| __unique:__ @test_edgecasesdistilled_lib_1_Example_get_v_ptr@ -} -foreign import ccall safe "hs_bindgen_9b325860ee78839e" hs_bindgen_9b325860ee78839e :: IO (Ptr Var_t) +hs_bindgen_9b325860ee78839e = fromBaseForeignType hs_bindgen_9b325860ee78839e_base {-# NOINLINE v_ptr #-} {-| __C declaration:__ @v@ diff --git a/hs-bindgen/fixtures/edge-cases/iterator/Example/FunPtr.hs b/hs-bindgen/fixtures/edge-cases/iterator/Example/FunPtr.hs index dd0f4bd33..d2f371ebe 100644 --- a/hs-bindgen/fixtures/edge-cases/iterator/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/edge-cases/iterator/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -90,10 +91,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7ac156a1e5f0a7d8" hs_bindgen_7ac156a1e5f0a7d8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CBool -> IO Toggle))) + {-| __unique:__ @test_edgecasesiterator_Example_get_makeToggle_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7ac156a1e5f0a7d8" hs_bindgen_7ac156a1e5f0a7d8 :: +hs_bindgen_7ac156a1e5f0a7d8 :: IO (Ptr.FunPtr (FC.CBool -> IO Toggle)) +hs_bindgen_7ac156a1e5f0a7d8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7ac156a1e5f0a7d8_base {-# NOINLINE makeToggle_ptr #-} @@ -107,10 +115,17 @@ makeToggle_ptr :: Ptr.FunPtr (FC.CBool -> IO Toggle) makeToggle_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7ac156a1e5f0a7d8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ea9e16aea1caff87" hs_bindgen_ea9e16aea1caff87_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Toggle -> IO FC.CBool))) + {-| __unique:__ @test_edgecasesiterator_Example_get_toggleNext_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ea9e16aea1caff87" hs_bindgen_ea9e16aea1caff87 :: +hs_bindgen_ea9e16aea1caff87 :: IO (Ptr.FunPtr (Toggle -> IO FC.CBool)) +hs_bindgen_ea9e16aea1caff87 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ea9e16aea1caff87_base {-# NOINLINE toggleNext_ptr #-} @@ -124,10 +139,17 @@ toggleNext_ptr :: Ptr.FunPtr (Toggle -> IO FC.CBool) toggleNext_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_ea9e16aea1caff87 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1a2eb91b4ecd58ef" hs_bindgen_1a2eb91b4ecd58ef_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Toggle -> IO ()))) + {-| __unique:__ @test_edgecasesiterator_Example_get_releaseToggle_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1a2eb91b4ecd58ef" hs_bindgen_1a2eb91b4ecd58ef :: +hs_bindgen_1a2eb91b4ecd58ef :: IO (Ptr.FunPtr (Toggle -> IO ())) +hs_bindgen_1a2eb91b4ecd58ef = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1a2eb91b4ecd58ef_base {-# NOINLINE releaseToggle_ptr #-} @@ -141,10 +163,17 @@ releaseToggle_ptr :: Ptr.FunPtr (Toggle -> IO ()) releaseToggle_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1a2eb91b4ecd58ef +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8254625fbaf5d305" hs_bindgen_8254625fbaf5d305_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> FC.CInt -> IO Counter))) + {-| __unique:__ @test_edgecasesiterator_Example_get_makeCounter_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8254625fbaf5d305" hs_bindgen_8254625fbaf5d305 :: +hs_bindgen_8254625fbaf5d305 :: IO (Ptr.FunPtr (FC.CInt -> FC.CInt -> IO Counter)) +hs_bindgen_8254625fbaf5d305 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8254625fbaf5d305_base {-# NOINLINE makeCounter_ptr #-} @@ -158,10 +187,17 @@ makeCounter_ptr :: Ptr.FunPtr (FC.CInt -> FC.CInt -> IO Counter) makeCounter_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8254625fbaf5d305 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_aaec448c4bfb8541" hs_bindgen_aaec448c4bfb8541_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Counter -> IO FC.CInt))) + {-| __unique:__ @test_edgecasesiterator_Example_get_counterNext_ptr@ -} -foreign import ccall unsafe "hs_bindgen_aaec448c4bfb8541" hs_bindgen_aaec448c4bfb8541 :: +hs_bindgen_aaec448c4bfb8541 :: IO (Ptr.FunPtr (Counter -> IO FC.CInt)) +hs_bindgen_aaec448c4bfb8541 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_aaec448c4bfb8541_base {-# NOINLINE counterNext_ptr #-} @@ -175,10 +211,17 @@ counterNext_ptr :: Ptr.FunPtr (Counter -> IO FC.CInt) counterNext_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_aaec448c4bfb8541 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7046cfbf9189e5b5" hs_bindgen_7046cfbf9189e5b5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Counter -> IO ()))) + {-| __unique:__ @test_edgecasesiterator_Example_get_releaseCounter_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7046cfbf9189e5b5" hs_bindgen_7046cfbf9189e5b5 :: +hs_bindgen_7046cfbf9189e5b5 :: IO (Ptr.FunPtr (Counter -> IO ())) +hs_bindgen_7046cfbf9189e5b5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7046cfbf9189e5b5_base {-# NOINLINE releaseCounter_ptr #-} @@ -192,10 +235,17 @@ releaseCounter_ptr :: Ptr.FunPtr (Counter -> IO ()) releaseCounter_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7046cfbf9189e5b5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c17e617bab3c2003" hs_bindgen_c17e617bab3c2003_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO VarCounter))) + {-| __unique:__ @test_edgecasesiterator_Example_get_makeVarCounter_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c17e617bab3c2003" hs_bindgen_c17e617bab3c2003 :: +hs_bindgen_c17e617bab3c2003 :: IO (Ptr.FunPtr (FC.CInt -> IO VarCounter)) +hs_bindgen_c17e617bab3c2003 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c17e617bab3c2003_base {-# NOINLINE makeVarCounter_ptr #-} @@ -209,10 +259,17 @@ makeVarCounter_ptr :: Ptr.FunPtr (FC.CInt -> IO VarCounter) makeVarCounter_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c17e617bab3c2003 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_429fd2c32d78e77a" hs_bindgen_429fd2c32d78e77a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (VarCounter -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_edgecasesiterator_Example_get_varCounterNext_ptr@ -} -foreign import ccall unsafe "hs_bindgen_429fd2c32d78e77a" hs_bindgen_429fd2c32d78e77a :: +hs_bindgen_429fd2c32d78e77a :: IO (Ptr.FunPtr (VarCounter -> FC.CInt -> IO FC.CInt)) +hs_bindgen_429fd2c32d78e77a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_429fd2c32d78e77a_base {-# NOINLINE varCounterNext_ptr #-} @@ -226,10 +283,17 @@ varCounterNext_ptr :: Ptr.FunPtr (VarCounter -> FC.CInt -> IO FC.CInt) varCounterNext_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_429fd2c32d78e77a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0059f6a0749bda00" hs_bindgen_0059f6a0749bda00_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (VarCounter -> IO ()))) + {-| __unique:__ @test_edgecasesiterator_Example_get_releaseVarCounter_ptr@ -} -foreign import ccall unsafe "hs_bindgen_0059f6a0749bda00" hs_bindgen_0059f6a0749bda00 :: +hs_bindgen_0059f6a0749bda00 :: IO (Ptr.FunPtr (VarCounter -> IO ())) +hs_bindgen_0059f6a0749bda00 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_0059f6a0749bda00_base {-# NOINLINE releaseVarCounter_ptr #-} diff --git a/hs-bindgen/fixtures/edge-cases/iterator/Example/Safe.hs b/hs-bindgen/fixtures/edge-cases/iterator/Example/Safe.hs index f3e172356..849e9b531 100644 --- a/hs-bindgen/fixtures/edge-cases/iterator/Example/Safe.hs +++ b/hs-bindgen/fixtures/edge-cases/iterator/Example/Safe.hs @@ -6,6 +6,7 @@ module Example.Safe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -70,6 +71,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9d01035006b66206" makeToggle_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CBool -> IO Toggle) + {-| __C declaration:__ @makeToggle@ __defined at:__ @edge-cases\/iterator.h:4:8@ @@ -78,11 +84,18 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesiterator_Example_Safe_makeToggle@ -} -foreign import ccall safe "hs_bindgen_9d01035006b66206" makeToggle :: +makeToggle :: FC.CBool {- ^ __C declaration:__ @start@ -} -> IO Toggle +makeToggle = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType makeToggle_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ccd3ba727d0c0cf4" toggleNext_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Toggle -> IO FC.CBool) {-| __C declaration:__ @toggleNext@ @@ -92,11 +105,18 @@ foreign import ccall safe "hs_bindgen_9d01035006b66206" makeToggle :: __unique:__ @test_edgecasesiterator_Example_Safe_toggleNext@ -} -foreign import ccall safe "hs_bindgen_ccd3ba727d0c0cf4" toggleNext :: +toggleNext :: Toggle {- ^ __C declaration:__ @block@ -} -> IO FC.CBool +toggleNext = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType toggleNext_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_602b40e971b06c72" releaseToggle_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Toggle -> IO ()) {-| __C declaration:__ @releaseToggle@ @@ -106,11 +126,18 @@ foreign import ccall safe "hs_bindgen_ccd3ba727d0c0cf4" toggleNext :: __unique:__ @test_edgecasesiterator_Example_Safe_releaseToggle@ -} -foreign import ccall safe "hs_bindgen_602b40e971b06c72" releaseToggle :: +releaseToggle :: Toggle {- ^ __C declaration:__ @block@ -} -> IO () +releaseToggle = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType releaseToggle_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_234fa6f1fb089e1d" makeCounter_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt -> IO Counter) {-| __C declaration:__ @makeCounter@ @@ -120,7 +147,7 @@ foreign import ccall safe "hs_bindgen_602b40e971b06c72" releaseToggle :: __unique:__ @test_edgecasesiterator_Example_Safe_makeCounter@ -} -foreign import ccall safe "hs_bindgen_234fa6f1fb089e1d" makeCounter :: +makeCounter :: FC.CInt {- ^ __C declaration:__ @start@ -} @@ -128,6 +155,13 @@ foreign import ccall safe "hs_bindgen_234fa6f1fb089e1d" makeCounter :: {- ^ __C declaration:__ @increment@ -} -> IO Counter +makeCounter = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType makeCounter_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f0fca62d78f225c3" counterNext_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Counter -> IO FC.CInt) {-| __C declaration:__ @counterNext@ @@ -137,11 +171,18 @@ foreign import ccall safe "hs_bindgen_234fa6f1fb089e1d" makeCounter :: __unique:__ @test_edgecasesiterator_Example_Safe_counterNext@ -} -foreign import ccall safe "hs_bindgen_f0fca62d78f225c3" counterNext :: +counterNext :: Counter {- ^ __C declaration:__ @block@ -} -> IO FC.CInt +counterNext = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType counterNext_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e42dcbee8a114957" releaseCounter_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Counter -> IO ()) {-| __C declaration:__ @releaseCounter@ @@ -151,11 +192,18 @@ foreign import ccall safe "hs_bindgen_f0fca62d78f225c3" counterNext :: __unique:__ @test_edgecasesiterator_Example_Safe_releaseCounter@ -} -foreign import ccall safe "hs_bindgen_e42dcbee8a114957" releaseCounter :: +releaseCounter :: Counter {- ^ __C declaration:__ @block@ -} -> IO () +releaseCounter = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType releaseCounter_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2bee4eb5b4d895c1" makeVarCounter_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO VarCounter) {-| __C declaration:__ @makeVarCounter@ @@ -165,11 +213,18 @@ foreign import ccall safe "hs_bindgen_e42dcbee8a114957" releaseCounter :: __unique:__ @test_edgecasesiterator_Example_Safe_makeVarCounter@ -} -foreign import ccall safe "hs_bindgen_2bee4eb5b4d895c1" makeVarCounter :: +makeVarCounter :: FC.CInt {- ^ __C declaration:__ @start@ -} -> IO VarCounter +makeVarCounter = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType makeVarCounter_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_276b9cb5320fec37" varCounterNext_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (VarCounter -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @varCounterNext@ @@ -179,7 +234,7 @@ foreign import ccall safe "hs_bindgen_2bee4eb5b4d895c1" makeVarCounter :: __unique:__ @test_edgecasesiterator_Example_Safe_varCounterNext@ -} -foreign import ccall safe "hs_bindgen_276b9cb5320fec37" varCounterNext :: +varCounterNext :: VarCounter {- ^ __C declaration:__ @block@ -} @@ -187,6 +242,13 @@ foreign import ccall safe "hs_bindgen_276b9cb5320fec37" varCounterNext :: {- ^ __C declaration:__ @increment@ -} -> IO FC.CInt +varCounterNext = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType varCounterNext_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8423b076f7c9df21" releaseVarCounter_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (VarCounter -> IO ()) {-| __C declaration:__ @releaseVarCounter@ @@ -196,8 +258,10 @@ foreign import ccall safe "hs_bindgen_276b9cb5320fec37" varCounterNext :: __unique:__ @test_edgecasesiterator_Example_Safe_releaseVarCounter@ -} -foreign import ccall safe "hs_bindgen_8423b076f7c9df21" releaseVarCounter :: +releaseVarCounter :: VarCounter {- ^ __C declaration:__ @block@ -} -> IO () +releaseVarCounter = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType releaseVarCounter_base diff --git a/hs-bindgen/fixtures/edge-cases/iterator/Example/Unsafe.hs b/hs-bindgen/fixtures/edge-cases/iterator/Example/Unsafe.hs index 3dcca310e..c7c5e4489 100644 --- a/hs-bindgen/fixtures/edge-cases/iterator/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/edge-cases/iterator/Example/Unsafe.hs @@ -6,6 +6,7 @@ module Example.Unsafe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -70,6 +71,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1b7a6a61a9c0da07" makeToggle_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CBool -> IO Toggle) + {-| __C declaration:__ @makeToggle@ __defined at:__ @edge-cases\/iterator.h:4:8@ @@ -78,11 +84,18 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesiterator_Example_Unsafe_makeToggle@ -} -foreign import ccall unsafe "hs_bindgen_1b7a6a61a9c0da07" makeToggle :: +makeToggle :: FC.CBool {- ^ __C declaration:__ @start@ -} -> IO Toggle +makeToggle = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType makeToggle_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4d2d650f2c8798d6" toggleNext_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Toggle -> IO FC.CBool) {-| __C declaration:__ @toggleNext@ @@ -92,11 +105,18 @@ foreign import ccall unsafe "hs_bindgen_1b7a6a61a9c0da07" makeToggle :: __unique:__ @test_edgecasesiterator_Example_Unsafe_toggleNext@ -} -foreign import ccall unsafe "hs_bindgen_4d2d650f2c8798d6" toggleNext :: +toggleNext :: Toggle {- ^ __C declaration:__ @block@ -} -> IO FC.CBool +toggleNext = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType toggleNext_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ddbe11e76502cbdc" releaseToggle_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Toggle -> IO ()) {-| __C declaration:__ @releaseToggle@ @@ -106,11 +126,18 @@ foreign import ccall unsafe "hs_bindgen_4d2d650f2c8798d6" toggleNext :: __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseToggle@ -} -foreign import ccall unsafe "hs_bindgen_ddbe11e76502cbdc" releaseToggle :: +releaseToggle :: Toggle {- ^ __C declaration:__ @block@ -} -> IO () +releaseToggle = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType releaseToggle_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2b04d558934551d2" makeCounter_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt -> IO Counter) {-| __C declaration:__ @makeCounter@ @@ -120,7 +147,7 @@ foreign import ccall unsafe "hs_bindgen_ddbe11e76502cbdc" releaseToggle :: __unique:__ @test_edgecasesiterator_Example_Unsafe_makeCounter@ -} -foreign import ccall unsafe "hs_bindgen_2b04d558934551d2" makeCounter :: +makeCounter :: FC.CInt {- ^ __C declaration:__ @start@ -} @@ -128,6 +155,13 @@ foreign import ccall unsafe "hs_bindgen_2b04d558934551d2" makeCounter :: {- ^ __C declaration:__ @increment@ -} -> IO Counter +makeCounter = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType makeCounter_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5bba69c8bfbeedf0" counterNext_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Counter -> IO FC.CInt) {-| __C declaration:__ @counterNext@ @@ -137,11 +171,18 @@ foreign import ccall unsafe "hs_bindgen_2b04d558934551d2" makeCounter :: __unique:__ @test_edgecasesiterator_Example_Unsafe_counterNext@ -} -foreign import ccall unsafe "hs_bindgen_5bba69c8bfbeedf0" counterNext :: +counterNext :: Counter {- ^ __C declaration:__ @block@ -} -> IO FC.CInt +counterNext = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType counterNext_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_429845bb55a5a7b5" releaseCounter_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Counter -> IO ()) {-| __C declaration:__ @releaseCounter@ @@ -151,11 +192,18 @@ foreign import ccall unsafe "hs_bindgen_5bba69c8bfbeedf0" counterNext :: __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseCounter@ -} -foreign import ccall unsafe "hs_bindgen_429845bb55a5a7b5" releaseCounter :: +releaseCounter :: Counter {- ^ __C declaration:__ @block@ -} -> IO () +releaseCounter = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType releaseCounter_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4421633e88fc96c4" makeVarCounter_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO VarCounter) {-| __C declaration:__ @makeVarCounter@ @@ -165,11 +213,18 @@ foreign import ccall unsafe "hs_bindgen_429845bb55a5a7b5" releaseCounter :: __unique:__ @test_edgecasesiterator_Example_Unsafe_makeVarCounter@ -} -foreign import ccall unsafe "hs_bindgen_4421633e88fc96c4" makeVarCounter :: +makeVarCounter :: FC.CInt {- ^ __C declaration:__ @start@ -} -> IO VarCounter +makeVarCounter = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType makeVarCounter_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_31edd817cb78027d" varCounterNext_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (VarCounter -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @varCounterNext@ @@ -179,7 +234,7 @@ foreign import ccall unsafe "hs_bindgen_4421633e88fc96c4" makeVarCounter :: __unique:__ @test_edgecasesiterator_Example_Unsafe_varCounterNext@ -} -foreign import ccall unsafe "hs_bindgen_31edd817cb78027d" varCounterNext :: +varCounterNext :: VarCounter {- ^ __C declaration:__ @block@ -} @@ -187,6 +242,13 @@ foreign import ccall unsafe "hs_bindgen_31edd817cb78027d" varCounterNext :: {- ^ __C declaration:__ @increment@ -} -> IO FC.CInt +varCounterNext = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType varCounterNext_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_32e5b257124f69a2" releaseVarCounter_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (VarCounter -> IO ()) {-| __C declaration:__ @releaseVarCounter@ @@ -196,8 +258,10 @@ foreign import ccall unsafe "hs_bindgen_31edd817cb78027d" varCounterNext :: __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseVarCounter@ -} -foreign import ccall unsafe "hs_bindgen_32e5b257124f69a2" releaseVarCounter :: +releaseVarCounter :: VarCounter {- ^ __C declaration:__ @block@ -} -> IO () +releaseVarCounter = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType releaseVarCounter_base diff --git a/hs-bindgen/fixtures/edge-cases/iterator/th.txt b/hs-bindgen/fixtures/edge-cases/iterator/th.txt index 48f0b5989..811f20812 100644 --- a/hs-bindgen/fixtures/edge-cases/iterator/th.txt +++ b/hs-bindgen/fixtures/edge-cases/iterator/th.txt @@ -250,6 +250,19 @@ instance HasCField VarCounter "un_VarCounter" where type CFieldType VarCounter "un_VarCounter" = Block (CInt -> IO CInt) offset# = \_ -> \_ -> 0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9d01035006b66206" makeToggle_base :: BaseForeignType (CBool -> + IO Toggle) +{-| __C declaration:__ @makeToggle@ + + __defined at:__ @edge-cases\/iterator.h:4:8@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_makeToggle@ +-} +makeToggle :: CBool -> IO Toggle {-| __C declaration:__ @makeToggle@ __defined at:__ @edge-cases\/iterator.h:4:8@ @@ -258,8 +271,20 @@ instance HasCField VarCounter "un_VarCounter" __unique:__ @test_edgecasesiterator_Example_Unsafe_makeToggle@ -} -foreign import ccall safe "hs_bindgen_9d01035006b66206" makeToggle :: CBool -> - IO Toggle +makeToggle = fromBaseForeignType makeToggle_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ccd3ba727d0c0cf4" toggleNext_base :: BaseForeignType (Toggle -> + IO CBool) +{-| __C declaration:__ @toggleNext@ + + __defined at:__ @edge-cases\/iterator.h:5:6@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_toggleNext@ +-} +toggleNext :: Toggle -> IO CBool {-| __C declaration:__ @toggleNext@ __defined at:__ @edge-cases\/iterator.h:5:6@ @@ -268,8 +293,20 @@ foreign import ccall safe "hs_bindgen_9d01035006b66206" makeToggle :: CBool -> __unique:__ @test_edgecasesiterator_Example_Unsafe_toggleNext@ -} -foreign import ccall safe "hs_bindgen_ccd3ba727d0c0cf4" toggleNext :: Toggle -> - IO CBool +toggleNext = fromBaseForeignType toggleNext_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_602b40e971b06c72" releaseToggle_base :: BaseForeignType (Toggle -> + IO Unit) +{-| __C declaration:__ @releaseToggle@ + + __defined at:__ @edge-cases\/iterator.h:6:6@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseToggle@ +-} +releaseToggle :: Toggle -> IO Unit {-| __C declaration:__ @releaseToggle@ __defined at:__ @edge-cases\/iterator.h:6:6@ @@ -278,8 +315,21 @@ foreign import ccall safe "hs_bindgen_ccd3ba727d0c0cf4" toggleNext :: Toggle -> __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseToggle@ -} -foreign import ccall safe "hs_bindgen_602b40e971b06c72" releaseToggle :: Toggle -> - IO Unit +releaseToggle = fromBaseForeignType releaseToggle_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_234fa6f1fb089e1d" makeCounter_base :: BaseForeignType (CInt -> + CInt -> + IO Counter) +{-| __C declaration:__ @makeCounter@ + + __defined at:__ @edge-cases\/iterator.h:11:9@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_makeCounter@ +-} +makeCounter :: CInt -> CInt -> IO Counter {-| __C declaration:__ @makeCounter@ __defined at:__ @edge-cases\/iterator.h:11:9@ @@ -288,8 +338,20 @@ foreign import ccall safe "hs_bindgen_602b40e971b06c72" releaseToggle :: Toggle __unique:__ @test_edgecasesiterator_Example_Unsafe_makeCounter@ -} -foreign import ccall safe "hs_bindgen_234fa6f1fb089e1d" makeCounter :: CInt -> - CInt -> IO Counter +makeCounter = fromBaseForeignType makeCounter_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f0fca62d78f225c3" counterNext_base :: BaseForeignType (Counter -> + IO CInt) +{-| __C declaration:__ @counterNext@ + + __defined at:__ @edge-cases\/iterator.h:12:5@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_counterNext@ +-} +counterNext :: Counter -> IO CInt {-| __C declaration:__ @counterNext@ __defined at:__ @edge-cases\/iterator.h:12:5@ @@ -298,8 +360,11 @@ foreign import ccall safe "hs_bindgen_234fa6f1fb089e1d" makeCounter :: CInt -> __unique:__ @test_edgecasesiterator_Example_Unsafe_counterNext@ -} -foreign import ccall safe "hs_bindgen_f0fca62d78f225c3" counterNext :: Counter -> - IO CInt +counterNext = fromBaseForeignType counterNext_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e42dcbee8a114957" releaseCounter_base :: BaseForeignType (Counter -> + IO Unit) {-| __C declaration:__ @releaseCounter@ __defined at:__ @edge-cases\/iterator.h:13:6@ @@ -308,8 +373,29 @@ foreign import ccall safe "hs_bindgen_f0fca62d78f225c3" counterNext :: Counter - __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseCounter@ -} -foreign import ccall safe "hs_bindgen_e42dcbee8a114957" releaseCounter :: Counter -> - IO Unit +releaseCounter :: Counter -> IO Unit +{-| __C declaration:__ @releaseCounter@ + + __defined at:__ @edge-cases\/iterator.h:13:6@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseCounter@ +-} +releaseCounter = fromBaseForeignType releaseCounter_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2bee4eb5b4d895c1" makeVarCounter_base :: BaseForeignType (CInt -> + IO VarCounter) +{-| __C declaration:__ @makeVarCounter@ + + __defined at:__ @edge-cases\/iterator.h:18:12@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_makeVarCounter@ +-} +makeVarCounter :: CInt -> IO VarCounter {-| __C declaration:__ @makeVarCounter@ __defined at:__ @edge-cases\/iterator.h:18:12@ @@ -318,8 +404,21 @@ foreign import ccall safe "hs_bindgen_e42dcbee8a114957" releaseCounter :: Counte __unique:__ @test_edgecasesiterator_Example_Unsafe_makeVarCounter@ -} -foreign import ccall safe "hs_bindgen_2bee4eb5b4d895c1" makeVarCounter :: CInt -> - IO VarCounter +makeVarCounter = fromBaseForeignType makeVarCounter_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_276b9cb5320fec37" varCounterNext_base :: BaseForeignType (VarCounter -> + CInt -> + IO CInt) +{-| __C declaration:__ @varCounterNext@ + + __defined at:__ @edge-cases\/iterator.h:19:5@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_varCounterNext@ +-} +varCounterNext :: VarCounter -> CInt -> IO CInt {-| __C declaration:__ @varCounterNext@ __defined at:__ @edge-cases\/iterator.h:19:5@ @@ -328,8 +427,20 @@ foreign import ccall safe "hs_bindgen_2bee4eb5b4d895c1" makeVarCounter :: CInt - __unique:__ @test_edgecasesiterator_Example_Unsafe_varCounterNext@ -} -foreign import ccall safe "hs_bindgen_276b9cb5320fec37" varCounterNext :: VarCounter -> - CInt -> IO CInt +varCounterNext = fromBaseForeignType varCounterNext_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8423b076f7c9df21" releaseVarCounter_base :: BaseForeignType (VarCounter -> + IO Unit) +{-| __C declaration:__ @releaseVarCounter@ + + __defined at:__ @edge-cases\/iterator.h:20:6@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseVarCounter@ +-} +releaseVarCounter :: VarCounter -> IO Unit {-| __C declaration:__ @releaseVarCounter@ __defined at:__ @edge-cases\/iterator.h:20:6@ @@ -338,8 +449,11 @@ foreign import ccall safe "hs_bindgen_276b9cb5320fec37" varCounterNext :: VarCou __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseVarCounter@ -} -foreign import ccall safe "hs_bindgen_8423b076f7c9df21" releaseVarCounter :: VarCounter -> - IO Unit +releaseVarCounter = fromBaseForeignType releaseVarCounter_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1b7a6a61a9c0da07" makeToggle_base :: BaseForeignType (CBool -> + IO Toggle) {-| __C declaration:__ @makeToggle@ __defined at:__ @edge-cases\/iterator.h:4:8@ @@ -348,8 +462,20 @@ foreign import ccall safe "hs_bindgen_8423b076f7c9df21" releaseVarCounter :: Var __unique:__ @test_edgecasesiterator_Example_Unsafe_makeToggle@ -} -foreign import ccall safe "hs_bindgen_1b7a6a61a9c0da07" makeToggle :: CBool -> - IO Toggle +makeToggle :: CBool -> IO Toggle +{-| __C declaration:__ @makeToggle@ + + __defined at:__ @edge-cases\/iterator.h:4:8@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_makeToggle@ +-} +makeToggle = fromBaseForeignType makeToggle_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4d2d650f2c8798d6" toggleNext_base :: BaseForeignType (Toggle -> + IO CBool) {-| __C declaration:__ @toggleNext@ __defined at:__ @edge-cases\/iterator.h:5:6@ @@ -358,8 +484,29 @@ foreign import ccall safe "hs_bindgen_1b7a6a61a9c0da07" makeToggle :: CBool -> __unique:__ @test_edgecasesiterator_Example_Unsafe_toggleNext@ -} -foreign import ccall safe "hs_bindgen_4d2d650f2c8798d6" toggleNext :: Toggle -> - IO CBool +toggleNext :: Toggle -> IO CBool +{-| __C declaration:__ @toggleNext@ + + __defined at:__ @edge-cases\/iterator.h:5:6@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_toggleNext@ +-} +toggleNext = fromBaseForeignType toggleNext_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ddbe11e76502cbdc" releaseToggle_base :: BaseForeignType (Toggle -> + IO Unit) +{-| __C declaration:__ @releaseToggle@ + + __defined at:__ @edge-cases\/iterator.h:6:6@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseToggle@ +-} +releaseToggle :: Toggle -> IO Unit {-| __C declaration:__ @releaseToggle@ __defined at:__ @edge-cases\/iterator.h:6:6@ @@ -368,8 +515,21 @@ foreign import ccall safe "hs_bindgen_4d2d650f2c8798d6" toggleNext :: Toggle -> __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseToggle@ -} -foreign import ccall safe "hs_bindgen_ddbe11e76502cbdc" releaseToggle :: Toggle -> - IO Unit +releaseToggle = fromBaseForeignType releaseToggle_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2b04d558934551d2" makeCounter_base :: BaseForeignType (CInt -> + CInt -> + IO Counter) +{-| __C declaration:__ @makeCounter@ + + __defined at:__ @edge-cases\/iterator.h:11:9@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_makeCounter@ +-} +makeCounter :: CInt -> CInt -> IO Counter {-| __C declaration:__ @makeCounter@ __defined at:__ @edge-cases\/iterator.h:11:9@ @@ -378,8 +538,11 @@ foreign import ccall safe "hs_bindgen_ddbe11e76502cbdc" releaseToggle :: Toggle __unique:__ @test_edgecasesiterator_Example_Unsafe_makeCounter@ -} -foreign import ccall safe "hs_bindgen_2b04d558934551d2" makeCounter :: CInt -> - CInt -> IO Counter +makeCounter = fromBaseForeignType makeCounter_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5bba69c8bfbeedf0" counterNext_base :: BaseForeignType (Counter -> + IO CInt) {-| __C declaration:__ @counterNext@ __defined at:__ @edge-cases\/iterator.h:12:5@ @@ -388,8 +551,20 @@ foreign import ccall safe "hs_bindgen_2b04d558934551d2" makeCounter :: CInt -> __unique:__ @test_edgecasesiterator_Example_Unsafe_counterNext@ -} -foreign import ccall safe "hs_bindgen_5bba69c8bfbeedf0" counterNext :: Counter -> - IO CInt +counterNext :: Counter -> IO CInt +{-| __C declaration:__ @counterNext@ + + __defined at:__ @edge-cases\/iterator.h:12:5@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_counterNext@ +-} +counterNext = fromBaseForeignType counterNext_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_429845bb55a5a7b5" releaseCounter_base :: BaseForeignType (Counter -> + IO Unit) {-| __C declaration:__ @releaseCounter@ __defined at:__ @edge-cases\/iterator.h:13:6@ @@ -398,8 +573,29 @@ foreign import ccall safe "hs_bindgen_5bba69c8bfbeedf0" counterNext :: Counter - __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseCounter@ -} -foreign import ccall safe "hs_bindgen_429845bb55a5a7b5" releaseCounter :: Counter -> - IO Unit +releaseCounter :: Counter -> IO Unit +{-| __C declaration:__ @releaseCounter@ + + __defined at:__ @edge-cases\/iterator.h:13:6@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseCounter@ +-} +releaseCounter = fromBaseForeignType releaseCounter_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4421633e88fc96c4" makeVarCounter_base :: BaseForeignType (CInt -> + IO VarCounter) +{-| __C declaration:__ @makeVarCounter@ + + __defined at:__ @edge-cases\/iterator.h:18:12@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_makeVarCounter@ +-} +makeVarCounter :: CInt -> IO VarCounter {-| __C declaration:__ @makeVarCounter@ __defined at:__ @edge-cases\/iterator.h:18:12@ @@ -408,8 +604,21 @@ foreign import ccall safe "hs_bindgen_429845bb55a5a7b5" releaseCounter :: Counte __unique:__ @test_edgecasesiterator_Example_Unsafe_makeVarCounter@ -} -foreign import ccall safe "hs_bindgen_4421633e88fc96c4" makeVarCounter :: CInt -> - IO VarCounter +makeVarCounter = fromBaseForeignType makeVarCounter_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_31edd817cb78027d" varCounterNext_base :: BaseForeignType (VarCounter -> + CInt -> + IO CInt) +{-| __C declaration:__ @varCounterNext@ + + __defined at:__ @edge-cases\/iterator.h:19:5@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_varCounterNext@ +-} +varCounterNext :: VarCounter -> CInt -> IO CInt {-| __C declaration:__ @varCounterNext@ __defined at:__ @edge-cases\/iterator.h:19:5@ @@ -418,8 +627,11 @@ foreign import ccall safe "hs_bindgen_4421633e88fc96c4" makeVarCounter :: CInt - __unique:__ @test_edgecasesiterator_Example_Unsafe_varCounterNext@ -} -foreign import ccall safe "hs_bindgen_31edd817cb78027d" varCounterNext :: VarCounter -> - CInt -> IO CInt +varCounterNext = fromBaseForeignType varCounterNext_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_32e5b257124f69a2" releaseVarCounter_base :: BaseForeignType (VarCounter -> + IO Unit) {-| __C declaration:__ @releaseVarCounter@ __defined at:__ @edge-cases\/iterator.h:20:6@ @@ -428,12 +640,26 @@ foreign import ccall safe "hs_bindgen_31edd817cb78027d" varCounterNext :: VarCou __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseVarCounter@ -} -foreign import ccall safe "hs_bindgen_32e5b257124f69a2" releaseVarCounter :: VarCounter -> - IO Unit +releaseVarCounter :: VarCounter -> IO Unit +{-| __C declaration:__ @releaseVarCounter@ + + __defined at:__ @edge-cases\/iterator.h:20:6@ + + __exported by:__ @edge-cases\/iterator.h@ + + __unique:__ @test_edgecasesiterator_Example_Unsafe_releaseVarCounter@ +-} +releaseVarCounter = fromBaseForeignType releaseVarCounter_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7ac156a1e5f0a7d8" hs_bindgen_7ac156a1e5f0a7d8_base :: BaseForeignType (IO (FunPtr (CBool -> + IO Toggle))) {-| __unique:__ @test_edgecasesiterator_Example_get_makeToggle_ptr@ -} -foreign import ccall safe "hs_bindgen_7ac156a1e5f0a7d8" hs_bindgen_7ac156a1e5f0a7d8 :: IO (FunPtr (CBool -> - IO Toggle)) +hs_bindgen_7ac156a1e5f0a7d8 :: IO (FunPtr (CBool -> IO Toggle)) +{-| __unique:__ @test_edgecasesiterator_Example_get_makeToggle_ptr@ +-} +hs_bindgen_7ac156a1e5f0a7d8 = fromBaseForeignType hs_bindgen_7ac156a1e5f0a7d8_base {-# NOINLINE makeToggle_ptr #-} {-| __C declaration:__ @makeToggle@ @@ -449,10 +675,16 @@ makeToggle_ptr :: FunPtr (CBool -> IO Toggle) __exported by:__ @edge-cases\/iterator.h@ -} makeToggle_ptr = unsafePerformIO hs_bindgen_7ac156a1e5f0a7d8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ea9e16aea1caff87" hs_bindgen_ea9e16aea1caff87_base :: BaseForeignType (IO (FunPtr (Toggle -> + IO CBool))) {-| __unique:__ @test_edgecasesiterator_Example_get_toggleNext_ptr@ -} -foreign import ccall safe "hs_bindgen_ea9e16aea1caff87" hs_bindgen_ea9e16aea1caff87 :: IO (FunPtr (Toggle -> - IO CBool)) +hs_bindgen_ea9e16aea1caff87 :: IO (FunPtr (Toggle -> IO CBool)) +{-| __unique:__ @test_edgecasesiterator_Example_get_toggleNext_ptr@ +-} +hs_bindgen_ea9e16aea1caff87 = fromBaseForeignType hs_bindgen_ea9e16aea1caff87_base {-# NOINLINE toggleNext_ptr #-} {-| __C declaration:__ @toggleNext@ @@ -468,10 +700,16 @@ toggleNext_ptr :: FunPtr (Toggle -> IO CBool) __exported by:__ @edge-cases\/iterator.h@ -} toggleNext_ptr = unsafePerformIO hs_bindgen_ea9e16aea1caff87 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1a2eb91b4ecd58ef" hs_bindgen_1a2eb91b4ecd58ef_base :: BaseForeignType (IO (FunPtr (Toggle -> + IO Unit))) {-| __unique:__ @test_edgecasesiterator_Example_get_releaseToggle_ptr@ -} -foreign import ccall safe "hs_bindgen_1a2eb91b4ecd58ef" hs_bindgen_1a2eb91b4ecd58ef :: IO (FunPtr (Toggle -> - IO Unit)) +hs_bindgen_1a2eb91b4ecd58ef :: IO (FunPtr (Toggle -> IO Unit)) +{-| __unique:__ @test_edgecasesiterator_Example_get_releaseToggle_ptr@ +-} +hs_bindgen_1a2eb91b4ecd58ef = fromBaseForeignType hs_bindgen_1a2eb91b4ecd58ef_base {-# NOINLINE releaseToggle_ptr #-} {-| __C declaration:__ @releaseToggle@ @@ -487,11 +725,18 @@ releaseToggle_ptr :: FunPtr (Toggle -> IO Unit) __exported by:__ @edge-cases\/iterator.h@ -} releaseToggle_ptr = unsafePerformIO hs_bindgen_1a2eb91b4ecd58ef +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8254625fbaf5d305" hs_bindgen_8254625fbaf5d305_base :: BaseForeignType (IO (FunPtr (CInt -> + CInt -> + IO Counter))) {-| __unique:__ @test_edgecasesiterator_Example_get_makeCounter_ptr@ -} -foreign import ccall safe "hs_bindgen_8254625fbaf5d305" hs_bindgen_8254625fbaf5d305 :: IO (FunPtr (CInt -> - CInt -> - IO Counter)) +hs_bindgen_8254625fbaf5d305 :: IO (FunPtr (CInt -> + CInt -> IO Counter)) +{-| __unique:__ @test_edgecasesiterator_Example_get_makeCounter_ptr@ +-} +hs_bindgen_8254625fbaf5d305 = fromBaseForeignType hs_bindgen_8254625fbaf5d305_base {-# NOINLINE makeCounter_ptr #-} {-| __C declaration:__ @makeCounter@ @@ -507,10 +752,16 @@ makeCounter_ptr :: FunPtr (CInt -> CInt -> IO Counter) __exported by:__ @edge-cases\/iterator.h@ -} makeCounter_ptr = unsafePerformIO hs_bindgen_8254625fbaf5d305 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aaec448c4bfb8541" hs_bindgen_aaec448c4bfb8541_base :: BaseForeignType (IO (FunPtr (Counter -> + IO CInt))) {-| __unique:__ @test_edgecasesiterator_Example_get_counterNext_ptr@ -} -foreign import ccall safe "hs_bindgen_aaec448c4bfb8541" hs_bindgen_aaec448c4bfb8541 :: IO (FunPtr (Counter -> - IO CInt)) +hs_bindgen_aaec448c4bfb8541 :: IO (FunPtr (Counter -> IO CInt)) +{-| __unique:__ @test_edgecasesiterator_Example_get_counterNext_ptr@ +-} +hs_bindgen_aaec448c4bfb8541 = fromBaseForeignType hs_bindgen_aaec448c4bfb8541_base {-# NOINLINE counterNext_ptr #-} {-| __C declaration:__ @counterNext@ @@ -526,10 +777,16 @@ counterNext_ptr :: FunPtr (Counter -> IO CInt) __exported by:__ @edge-cases\/iterator.h@ -} counterNext_ptr = unsafePerformIO hs_bindgen_aaec448c4bfb8541 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7046cfbf9189e5b5" hs_bindgen_7046cfbf9189e5b5_base :: BaseForeignType (IO (FunPtr (Counter -> + IO Unit))) {-| __unique:__ @test_edgecasesiterator_Example_get_releaseCounter_ptr@ -} -foreign import ccall safe "hs_bindgen_7046cfbf9189e5b5" hs_bindgen_7046cfbf9189e5b5 :: IO (FunPtr (Counter -> - IO Unit)) +hs_bindgen_7046cfbf9189e5b5 :: IO (FunPtr (Counter -> IO Unit)) +{-| __unique:__ @test_edgecasesiterator_Example_get_releaseCounter_ptr@ +-} +hs_bindgen_7046cfbf9189e5b5 = fromBaseForeignType hs_bindgen_7046cfbf9189e5b5_base {-# NOINLINE releaseCounter_ptr #-} {-| __C declaration:__ @releaseCounter@ @@ -545,10 +802,16 @@ releaseCounter_ptr :: FunPtr (Counter -> IO Unit) __exported by:__ @edge-cases\/iterator.h@ -} releaseCounter_ptr = unsafePerformIO hs_bindgen_7046cfbf9189e5b5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c17e617bab3c2003" hs_bindgen_c17e617bab3c2003_base :: BaseForeignType (IO (FunPtr (CInt -> + IO VarCounter))) {-| __unique:__ @test_edgecasesiterator_Example_get_makeVarCounter_ptr@ -} -foreign import ccall safe "hs_bindgen_c17e617bab3c2003" hs_bindgen_c17e617bab3c2003 :: IO (FunPtr (CInt -> - IO VarCounter)) +hs_bindgen_c17e617bab3c2003 :: IO (FunPtr (CInt -> IO VarCounter)) +{-| __unique:__ @test_edgecasesiterator_Example_get_makeVarCounter_ptr@ +-} +hs_bindgen_c17e617bab3c2003 = fromBaseForeignType hs_bindgen_c17e617bab3c2003_base {-# NOINLINE makeVarCounter_ptr #-} {-| __C declaration:__ @makeVarCounter@ @@ -564,11 +827,18 @@ makeVarCounter_ptr :: FunPtr (CInt -> IO VarCounter) __exported by:__ @edge-cases\/iterator.h@ -} makeVarCounter_ptr = unsafePerformIO hs_bindgen_c17e617bab3c2003 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_429fd2c32d78e77a" hs_bindgen_429fd2c32d78e77a_base :: BaseForeignType (IO (FunPtr (VarCounter -> + CInt -> + IO CInt))) {-| __unique:__ @test_edgecasesiterator_Example_get_varCounterNext_ptr@ -} -foreign import ccall safe "hs_bindgen_429fd2c32d78e77a" hs_bindgen_429fd2c32d78e77a :: IO (FunPtr (VarCounter -> - CInt -> - IO CInt)) +hs_bindgen_429fd2c32d78e77a :: IO (FunPtr (VarCounter -> + CInt -> IO CInt)) +{-| __unique:__ @test_edgecasesiterator_Example_get_varCounterNext_ptr@ +-} +hs_bindgen_429fd2c32d78e77a = fromBaseForeignType hs_bindgen_429fd2c32d78e77a_base {-# NOINLINE varCounterNext_ptr #-} {-| __C declaration:__ @varCounterNext@ @@ -584,10 +854,16 @@ varCounterNext_ptr :: FunPtr (VarCounter -> CInt -> IO CInt) __exported by:__ @edge-cases\/iterator.h@ -} varCounterNext_ptr = unsafePerformIO hs_bindgen_429fd2c32d78e77a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0059f6a0749bda00" hs_bindgen_0059f6a0749bda00_base :: BaseForeignType (IO (FunPtr (VarCounter -> + IO Unit))) +{-| __unique:__ @test_edgecasesiterator_Example_get_releaseVarCounter_ptr@ +-} +hs_bindgen_0059f6a0749bda00 :: IO (FunPtr (VarCounter -> IO Unit)) {-| __unique:__ @test_edgecasesiterator_Example_get_releaseVarCounter_ptr@ -} -foreign import ccall safe "hs_bindgen_0059f6a0749bda00" hs_bindgen_0059f6a0749bda00 :: IO (FunPtr (VarCounter -> - IO Unit)) +hs_bindgen_0059f6a0749bda00 = fromBaseForeignType hs_bindgen_0059f6a0749bda00_base {-# NOINLINE releaseVarCounter_ptr #-} {-| __C declaration:__ @releaseVarCounter@ diff --git a/hs-bindgen/fixtures/edge-cases/names/Example/FunPtr.hs b/hs-bindgen/fixtures/edge-cases/names/Example/FunPtr.hs index e278dd5bb..bbf4b4b0e 100644 --- a/hs-bindgen/fixtures/edge-cases/names/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/edge-cases/names/Example/FunPtr.hs @@ -7,6 +7,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -164,10 +165,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6974dc9d1fd9efdb" hs_bindgen_6974dc9d1fd9efdb_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_by_ptr@ -} -foreign import ccall unsafe "hs_bindgen_6974dc9d1fd9efdb" hs_bindgen_6974dc9d1fd9efdb :: +hs_bindgen_6974dc9d1fd9efdb :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_6974dc9d1fd9efdb = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_6974dc9d1fd9efdb_base {-# NOINLINE by'_ptr #-} @@ -181,10 +189,17 @@ by'_ptr :: Ptr.FunPtr (IO ()) by'_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_6974dc9d1fd9efdb +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3b643ea94c4ffa20" hs_bindgen_3b643ea94c4ffa20_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_forall_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3b643ea94c4ffa20" hs_bindgen_3b643ea94c4ffa20 :: +hs_bindgen_3b643ea94c4ffa20 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_3b643ea94c4ffa20 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3b643ea94c4ffa20_base {-# NOINLINE forall'_ptr #-} @@ -198,10 +213,17 @@ forall'_ptr :: Ptr.FunPtr (IO ()) forall'_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3b643ea94c4ffa20 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_75a958dcb6aa760d" hs_bindgen_75a958dcb6aa760d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_mdo_ptr@ -} -foreign import ccall unsafe "hs_bindgen_75a958dcb6aa760d" hs_bindgen_75a958dcb6aa760d :: +hs_bindgen_75a958dcb6aa760d :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_75a958dcb6aa760d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_75a958dcb6aa760d_base {-# NOINLINE mdo'_ptr #-} @@ -215,10 +237,17 @@ mdo'_ptr :: Ptr.FunPtr (IO ()) mdo'_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_75a958dcb6aa760d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2dca22d927c6b6c9" hs_bindgen_2dca22d927c6b6c9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_pattern_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2dca22d927c6b6c9" hs_bindgen_2dca22d927c6b6c9 :: +hs_bindgen_2dca22d927c6b6c9 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_2dca22d927c6b6c9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2dca22d927c6b6c9_base {-# NOINLINE pattern'_ptr #-} @@ -232,10 +261,17 @@ pattern'_ptr :: Ptr.FunPtr (IO ()) pattern'_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2dca22d927c6b6c9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_278f3b1df8a83886" hs_bindgen_278f3b1df8a83886_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_proc_ptr@ -} -foreign import ccall unsafe "hs_bindgen_278f3b1df8a83886" hs_bindgen_278f3b1df8a83886 :: +hs_bindgen_278f3b1df8a83886 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_278f3b1df8a83886 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_278f3b1df8a83886_base {-# NOINLINE proc'_ptr #-} @@ -249,10 +285,17 @@ proc'_ptr :: Ptr.FunPtr (IO ()) proc'_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_278f3b1df8a83886 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3be0a960ee51c3e9" hs_bindgen_3be0a960ee51c3e9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_rec_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3be0a960ee51c3e9" hs_bindgen_3be0a960ee51c3e9 :: +hs_bindgen_3be0a960ee51c3e9 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_3be0a960ee51c3e9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3be0a960ee51c3e9_base {-# NOINLINE rec'_ptr #-} @@ -266,10 +309,17 @@ rec'_ptr :: Ptr.FunPtr (IO ()) rec'_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3be0a960ee51c3e9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_84e44d3bf799af26" hs_bindgen_84e44d3bf799af26_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_using_ptr@ -} -foreign import ccall unsafe "hs_bindgen_84e44d3bf799af26" hs_bindgen_84e44d3bf799af26 :: +hs_bindgen_84e44d3bf799af26 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_84e44d3bf799af26 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_84e44d3bf799af26_base {-# NOINLINE using'_ptr #-} @@ -283,10 +333,17 @@ using'_ptr :: Ptr.FunPtr (IO ()) using'_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_84e44d3bf799af26 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_95cf172ae2160046" hs_bindgen_95cf172ae2160046_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_anyclass_ptr@ -} -foreign import ccall unsafe "hs_bindgen_95cf172ae2160046" hs_bindgen_95cf172ae2160046 :: +hs_bindgen_95cf172ae2160046 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_95cf172ae2160046 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_95cf172ae2160046_base {-# NOINLINE anyclass_ptr #-} @@ -300,10 +357,17 @@ anyclass_ptr :: Ptr.FunPtr (IO ()) anyclass_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_95cf172ae2160046 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ea4d99f6c2e96742" hs_bindgen_ea4d99f6c2e96742_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_capi_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ea4d99f6c2e96742" hs_bindgen_ea4d99f6c2e96742 :: +hs_bindgen_ea4d99f6c2e96742 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_ea4d99f6c2e96742 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ea4d99f6c2e96742_base {-# NOINLINE capi_ptr #-} @@ -317,10 +381,17 @@ capi_ptr :: Ptr.FunPtr (IO ()) capi_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_ea4d99f6c2e96742 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_aff69f10c4c30a0d" hs_bindgen_aff69f10c4c30a0d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_cases_ptr@ -} -foreign import ccall unsafe "hs_bindgen_aff69f10c4c30a0d" hs_bindgen_aff69f10c4c30a0d :: +hs_bindgen_aff69f10c4c30a0d :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_aff69f10c4c30a0d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_aff69f10c4c30a0d_base {-# NOINLINE cases_ptr #-} @@ -334,10 +405,17 @@ cases_ptr :: Ptr.FunPtr (IO ()) cases_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_aff69f10c4c30a0d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f5db0ca2d6dce4d5" hs_bindgen_f5db0ca2d6dce4d5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_ccall_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f5db0ca2d6dce4d5" hs_bindgen_f5db0ca2d6dce4d5 :: +hs_bindgen_f5db0ca2d6dce4d5 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_f5db0ca2d6dce4d5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f5db0ca2d6dce4d5_base {-# NOINLINE ccall_ptr #-} @@ -351,10 +429,17 @@ ccall_ptr :: Ptr.FunPtr (IO ()) ccall_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f5db0ca2d6dce4d5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d5e3711b7b2f435e" hs_bindgen_d5e3711b7b2f435e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_dynamic_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d5e3711b7b2f435e" hs_bindgen_d5e3711b7b2f435e :: +hs_bindgen_d5e3711b7b2f435e :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_d5e3711b7b2f435e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d5e3711b7b2f435e_base {-# NOINLINE dynamic_ptr #-} @@ -368,10 +453,17 @@ dynamic_ptr :: Ptr.FunPtr (IO ()) dynamic_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d5e3711b7b2f435e +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c3e4c5611dd8ffdf" hs_bindgen_c3e4c5611dd8ffdf_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_export_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c3e4c5611dd8ffdf" hs_bindgen_c3e4c5611dd8ffdf :: +hs_bindgen_c3e4c5611dd8ffdf :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_c3e4c5611dd8ffdf = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c3e4c5611dd8ffdf_base {-# NOINLINE export_ptr #-} @@ -385,10 +477,17 @@ export_ptr :: Ptr.FunPtr (IO ()) export_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c3e4c5611dd8ffdf +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_658a25f6c844805b" hs_bindgen_658a25f6c844805b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_family_ptr@ -} -foreign import ccall unsafe "hs_bindgen_658a25f6c844805b" hs_bindgen_658a25f6c844805b :: +hs_bindgen_658a25f6c844805b :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_658a25f6c844805b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_658a25f6c844805b_base {-# NOINLINE family_ptr #-} @@ -402,10 +501,17 @@ family_ptr :: Ptr.FunPtr (IO ()) family_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_658a25f6c844805b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0c7fb62fb95f0f38" hs_bindgen_0c7fb62fb95f0f38_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_group_ptr@ -} -foreign import ccall unsafe "hs_bindgen_0c7fb62fb95f0f38" hs_bindgen_0c7fb62fb95f0f38 :: +hs_bindgen_0c7fb62fb95f0f38 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_0c7fb62fb95f0f38 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_0c7fb62fb95f0f38_base {-# NOINLINE group_ptr #-} @@ -419,10 +525,17 @@ group_ptr :: Ptr.FunPtr (IO ()) group_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_0c7fb62fb95f0f38 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bb9472bbc501c78f" hs_bindgen_bb9472bbc501c78f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_interruptible_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bb9472bbc501c78f" hs_bindgen_bb9472bbc501c78f :: +hs_bindgen_bb9472bbc501c78f :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_bb9472bbc501c78f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bb9472bbc501c78f_base {-# NOINLINE interruptible_ptr #-} @@ -436,10 +549,17 @@ interruptible_ptr :: Ptr.FunPtr (IO ()) interruptible_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bb9472bbc501c78f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0c7eeee673af7865" hs_bindgen_0c7eeee673af7865_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_javascript_ptr@ -} -foreign import ccall unsafe "hs_bindgen_0c7eeee673af7865" hs_bindgen_0c7eeee673af7865 :: +hs_bindgen_0c7eeee673af7865 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_0c7eeee673af7865 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_0c7eeee673af7865_base {-# NOINLINE javascript_ptr #-} @@ -453,10 +573,17 @@ javascript_ptr :: Ptr.FunPtr (IO ()) javascript_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_0c7eeee673af7865 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d16291c6c6c905ab" hs_bindgen_d16291c6c6c905ab_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_label_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d16291c6c6c905ab" hs_bindgen_d16291c6c6c905ab :: +hs_bindgen_d16291c6c6c905ab :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_d16291c6c6c905ab = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d16291c6c6c905ab_base {-# NOINLINE label_ptr #-} @@ -470,10 +597,17 @@ label_ptr :: Ptr.FunPtr (IO ()) label_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d16291c6c6c905ab +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0657843e52c044fe" hs_bindgen_0657843e52c044fe_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_prim_ptr@ -} -foreign import ccall unsafe "hs_bindgen_0657843e52c044fe" hs_bindgen_0657843e52c044fe :: +hs_bindgen_0657843e52c044fe :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_0657843e52c044fe = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_0657843e52c044fe_base {-# NOINLINE prim_ptr #-} @@ -487,10 +621,17 @@ prim_ptr :: Ptr.FunPtr (IO ()) prim_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_0657843e52c044fe +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bdbcb244d39fa251" hs_bindgen_bdbcb244d39fa251_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_role_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bdbcb244d39fa251" hs_bindgen_bdbcb244d39fa251 :: +hs_bindgen_bdbcb244d39fa251 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_bdbcb244d39fa251 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bdbcb244d39fa251_base {-# NOINLINE role_ptr #-} @@ -504,10 +645,17 @@ role_ptr :: Ptr.FunPtr (IO ()) role_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bdbcb244d39fa251 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_400c28e571f13194" hs_bindgen_400c28e571f13194_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_safe_ptr@ -} -foreign import ccall unsafe "hs_bindgen_400c28e571f13194" hs_bindgen_400c28e571f13194 :: +hs_bindgen_400c28e571f13194 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_400c28e571f13194 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_400c28e571f13194_base {-# NOINLINE safe_ptr #-} @@ -521,10 +669,17 @@ safe_ptr :: Ptr.FunPtr (IO ()) safe_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_400c28e571f13194 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_15aff4a3542e1023" hs_bindgen_15aff4a3542e1023_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_stdcall_ptr@ -} -foreign import ccall unsafe "hs_bindgen_15aff4a3542e1023" hs_bindgen_15aff4a3542e1023 :: +hs_bindgen_15aff4a3542e1023 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_15aff4a3542e1023 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_15aff4a3542e1023_base {-# NOINLINE stdcall_ptr #-} @@ -538,10 +693,17 @@ stdcall_ptr :: Ptr.FunPtr (IO ()) stdcall_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_15aff4a3542e1023 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9df7dc3f71a3ab76" hs_bindgen_9df7dc3f71a3ab76_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_stock_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9df7dc3f71a3ab76" hs_bindgen_9df7dc3f71a3ab76 :: +hs_bindgen_9df7dc3f71a3ab76 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_9df7dc3f71a3ab76 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9df7dc3f71a3ab76_base {-# NOINLINE stock_ptr #-} @@ -555,10 +717,17 @@ stock_ptr :: Ptr.FunPtr (IO ()) stock_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9df7dc3f71a3ab76 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_aebb5b55a2d78a79" hs_bindgen_aebb5b55a2d78a79_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_unsafe_ptr@ -} -foreign import ccall unsafe "hs_bindgen_aebb5b55a2d78a79" hs_bindgen_aebb5b55a2d78a79 :: +hs_bindgen_aebb5b55a2d78a79 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_aebb5b55a2d78a79 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_aebb5b55a2d78a79_base {-# NOINLINE unsafe_ptr #-} @@ -572,10 +741,17 @@ unsafe_ptr :: Ptr.FunPtr (IO ()) unsafe_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_aebb5b55a2d78a79 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c6fe1f3a125fa32d" hs_bindgen_c6fe1f3a125fa32d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_edgecasesnames_Example_get_via_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c6fe1f3a125fa32d" hs_bindgen_c6fe1f3a125fa32d :: +hs_bindgen_c6fe1f3a125fa32d :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_c6fe1f3a125fa32d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c6fe1f3a125fa32d_base {-# NOINLINE via_ptr #-} diff --git a/hs-bindgen/fixtures/edge-cases/names/Example/Safe.hs b/hs-bindgen/fixtures/edge-cases/names/Example/Safe.hs index 8dfe51d30..b56c9af29 100644 --- a/hs-bindgen/fixtures/edge-cases/names/Example/Safe.hs +++ b/hs-bindgen/fixtures/edge-cases/names/Example/Safe.hs @@ -5,6 +5,7 @@ module Example.Safe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -112,6 +113,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_601290db9e101424" by'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @by@ __defined at:__ @edge-cases\/names.h:3:6@ @@ -120,8 +126,15 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesnames_Example_Safe_by@ -} -foreign import ccall safe "hs_bindgen_601290db9e101424" by' :: +by' :: IO () +by' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType by'_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f03dbed5eebb711a" forall'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @forall@ @@ -131,8 +144,15 @@ foreign import ccall safe "hs_bindgen_601290db9e101424" by' :: __unique:__ @test_edgecasesnames_Example_Safe_forall@ -} -foreign import ccall safe "hs_bindgen_f03dbed5eebb711a" forall' :: +forall' :: IO () +forall' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType forall'_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d1e3196c869f9fa1" mdo'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @mdo@ @@ -142,8 +162,15 @@ foreign import ccall safe "hs_bindgen_f03dbed5eebb711a" forall' :: __unique:__ @test_edgecasesnames_Example_Safe_mdo@ -} -foreign import ccall safe "hs_bindgen_d1e3196c869f9fa1" mdo' :: +mdo' :: IO () +mdo' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType mdo'_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d3dcd898c88fb2e0" pattern'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @pattern@ @@ -153,8 +180,15 @@ foreign import ccall safe "hs_bindgen_d1e3196c869f9fa1" mdo' :: __unique:__ @test_edgecasesnames_Example_Safe_pattern@ -} -foreign import ccall safe "hs_bindgen_d3dcd898c88fb2e0" pattern' :: +pattern' :: IO () +pattern' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType pattern'_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7f08456473f564e3" proc'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @proc@ @@ -164,8 +198,15 @@ foreign import ccall safe "hs_bindgen_d3dcd898c88fb2e0" pattern' :: __unique:__ @test_edgecasesnames_Example_Safe_proc@ -} -foreign import ccall safe "hs_bindgen_7f08456473f564e3" proc' :: +proc' :: IO () +proc' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType proc'_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5df814c22f546599" rec'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @rec@ @@ -175,8 +216,15 @@ foreign import ccall safe "hs_bindgen_7f08456473f564e3" proc' :: __unique:__ @test_edgecasesnames_Example_Safe_rec@ -} -foreign import ccall safe "hs_bindgen_5df814c22f546599" rec' :: +rec' :: IO () +rec' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType rec'_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3877b6deb653b5a4" using'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @using@ @@ -186,8 +234,15 @@ foreign import ccall safe "hs_bindgen_5df814c22f546599" rec' :: __unique:__ @test_edgecasesnames_Example_Safe_using@ -} -foreign import ccall safe "hs_bindgen_3877b6deb653b5a4" using' :: +using' :: IO () +using' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType using'_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7b8790d04357731b" anyclass_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @anyclass@ @@ -197,8 +252,15 @@ foreign import ccall safe "hs_bindgen_3877b6deb653b5a4" using' :: __unique:__ @test_edgecasesnames_Example_Safe_anyclass@ -} -foreign import ccall safe "hs_bindgen_7b8790d04357731b" anyclass :: +anyclass :: IO () +anyclass = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType anyclass_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0bf4ab515f3279b9" capi_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @capi@ @@ -208,8 +270,15 @@ foreign import ccall safe "hs_bindgen_7b8790d04357731b" anyclass :: __unique:__ @test_edgecasesnames_Example_Safe_capi@ -} -foreign import ccall safe "hs_bindgen_0bf4ab515f3279b9" capi :: +capi :: IO () +capi = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType capi_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fa8166b2793e4236" cases_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @cases@ @@ -219,8 +288,15 @@ foreign import ccall safe "hs_bindgen_0bf4ab515f3279b9" capi :: __unique:__ @test_edgecasesnames_Example_Safe_cases@ -} -foreign import ccall safe "hs_bindgen_fa8166b2793e4236" cases :: +cases :: IO () +cases = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType cases_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_decc2d43a62d063d" ccall_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @ccall@ @@ -230,8 +306,15 @@ foreign import ccall safe "hs_bindgen_fa8166b2793e4236" cases :: __unique:__ @test_edgecasesnames_Example_Safe_ccall@ -} -foreign import ccall safe "hs_bindgen_decc2d43a62d063d" ccall :: +ccall :: IO () +ccall = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ccall_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b5a75e2b6434134b" dynamic_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @dynamic@ @@ -241,8 +324,15 @@ foreign import ccall safe "hs_bindgen_decc2d43a62d063d" ccall :: __unique:__ @test_edgecasesnames_Example_Safe_dynamic@ -} -foreign import ccall safe "hs_bindgen_b5a75e2b6434134b" dynamic :: +dynamic :: IO () +dynamic = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType dynamic_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_406f7b014573b3d3" export_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @export@ @@ -252,8 +342,15 @@ foreign import ccall safe "hs_bindgen_b5a75e2b6434134b" dynamic :: __unique:__ @test_edgecasesnames_Example_Safe_export@ -} -foreign import ccall safe "hs_bindgen_406f7b014573b3d3" export :: +export :: IO () +export = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType export_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_14aab2af04efc222" family_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @family@ @@ -263,8 +360,15 @@ foreign import ccall safe "hs_bindgen_406f7b014573b3d3" export :: __unique:__ @test_edgecasesnames_Example_Safe_family@ -} -foreign import ccall safe "hs_bindgen_14aab2af04efc222" family :: +family :: IO () +family = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType family_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ee9285b26b11b393" group_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @group@ @@ -274,8 +378,15 @@ foreign import ccall safe "hs_bindgen_14aab2af04efc222" family :: __unique:__ @test_edgecasesnames_Example_Safe_group@ -} -foreign import ccall safe "hs_bindgen_ee9285b26b11b393" group :: +group :: IO () +group = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType group_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b2463d5c1d51883e" interruptible_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @interruptible@ @@ -285,8 +396,15 @@ foreign import ccall safe "hs_bindgen_ee9285b26b11b393" group :: __unique:__ @test_edgecasesnames_Example_Safe_interruptible@ -} -foreign import ccall safe "hs_bindgen_b2463d5c1d51883e" interruptible :: +interruptible :: IO () +interruptible = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType interruptible_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_55a55462d9cd296c" javascript_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @javascript@ @@ -296,8 +414,15 @@ foreign import ccall safe "hs_bindgen_b2463d5c1d51883e" interruptible :: __unique:__ @test_edgecasesnames_Example_Safe_javascript@ -} -foreign import ccall safe "hs_bindgen_55a55462d9cd296c" javascript :: +javascript :: IO () +javascript = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType javascript_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_227f34efb176d1fb" label_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @label@ @@ -307,8 +432,15 @@ foreign import ccall safe "hs_bindgen_55a55462d9cd296c" javascript :: __unique:__ @test_edgecasesnames_Example_Safe_label@ -} -foreign import ccall safe "hs_bindgen_227f34efb176d1fb" label :: +label :: IO () +label = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType label_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_51c6e0d18dce403a" prim_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @prim@ @@ -318,8 +450,15 @@ foreign import ccall safe "hs_bindgen_227f34efb176d1fb" label :: __unique:__ @test_edgecasesnames_Example_Safe_prim@ -} -foreign import ccall safe "hs_bindgen_51c6e0d18dce403a" prim :: +prim :: IO () +prim = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType prim_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f85f2418d208e6a0" role_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @role@ @@ -329,8 +468,15 @@ foreign import ccall safe "hs_bindgen_51c6e0d18dce403a" prim :: __unique:__ @test_edgecasesnames_Example_Safe_role@ -} -foreign import ccall safe "hs_bindgen_f85f2418d208e6a0" role :: +role :: IO () +role = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType role_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0855ecbc4b53ebbb" safe_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @safe@ @@ -340,8 +486,15 @@ foreign import ccall safe "hs_bindgen_f85f2418d208e6a0" role :: __unique:__ @test_edgecasesnames_Example_Safe_safe@ -} -foreign import ccall safe "hs_bindgen_0855ecbc4b53ebbb" safe :: +safe :: IO () +safe = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType safe_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e5238d13788a6df9" stdcall_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @stdcall@ @@ -351,8 +504,15 @@ foreign import ccall safe "hs_bindgen_0855ecbc4b53ebbb" safe :: __unique:__ @test_edgecasesnames_Example_Safe_stdcall@ -} -foreign import ccall safe "hs_bindgen_e5238d13788a6df9" stdcall :: +stdcall :: IO () +stdcall = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType stdcall_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cf38d8bd096a7a42" stock_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @stock@ @@ -362,8 +522,15 @@ foreign import ccall safe "hs_bindgen_e5238d13788a6df9" stdcall :: __unique:__ @test_edgecasesnames_Example_Safe_stock@ -} -foreign import ccall safe "hs_bindgen_cf38d8bd096a7a42" stock :: +stock :: IO () +stock = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType stock_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fda9b083b24404f0" unsafe_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @unsafe@ @@ -373,8 +540,15 @@ foreign import ccall safe "hs_bindgen_cf38d8bd096a7a42" stock :: __unique:__ @test_edgecasesnames_Example_Safe_unsafe@ -} -foreign import ccall safe "hs_bindgen_fda9b083b24404f0" unsafe :: +unsafe :: IO () +unsafe = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType unsafe_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1d2a76a3a595be25" via_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @via@ @@ -384,5 +558,7 @@ foreign import ccall safe "hs_bindgen_fda9b083b24404f0" unsafe :: __unique:__ @test_edgecasesnames_Example_Safe_via@ -} -foreign import ccall safe "hs_bindgen_1d2a76a3a595be25" via :: +via :: IO () +via = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType via_base diff --git a/hs-bindgen/fixtures/edge-cases/names/Example/Unsafe.hs b/hs-bindgen/fixtures/edge-cases/names/Example/Unsafe.hs index 7528fc719..867d071f2 100644 --- a/hs-bindgen/fixtures/edge-cases/names/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/edge-cases/names/Example/Unsafe.hs @@ -5,6 +5,7 @@ module Example.Unsafe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -112,6 +113,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_28b998af1f39a743" by'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @by@ __defined at:__ @edge-cases\/names.h:3:6@ @@ -120,8 +126,15 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesnames_Example_Unsafe_by@ -} -foreign import ccall unsafe "hs_bindgen_28b998af1f39a743" by' :: +by' :: IO () +by' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType by'_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5d7ea7c4d11a5fc8" forall'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @forall@ @@ -131,8 +144,15 @@ foreign import ccall unsafe "hs_bindgen_28b998af1f39a743" by' :: __unique:__ @test_edgecasesnames_Example_Unsafe_forall@ -} -foreign import ccall unsafe "hs_bindgen_5d7ea7c4d11a5fc8" forall' :: +forall' :: IO () +forall' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType forall'_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2d65448c684c09d5" mdo'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @mdo@ @@ -142,8 +162,15 @@ foreign import ccall unsafe "hs_bindgen_5d7ea7c4d11a5fc8" forall' :: __unique:__ @test_edgecasesnames_Example_Unsafe_mdo@ -} -foreign import ccall unsafe "hs_bindgen_2d65448c684c09d5" mdo' :: +mdo' :: IO () +mdo' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType mdo'_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_13fe653d670d3712" pattern'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @pattern@ @@ -153,8 +180,15 @@ foreign import ccall unsafe "hs_bindgen_2d65448c684c09d5" mdo' :: __unique:__ @test_edgecasesnames_Example_Unsafe_pattern@ -} -foreign import ccall unsafe "hs_bindgen_13fe653d670d3712" pattern' :: +pattern' :: IO () +pattern' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType pattern'_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e9cc2037d33041aa" proc'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @proc@ @@ -164,8 +198,15 @@ foreign import ccall unsafe "hs_bindgen_13fe653d670d3712" pattern' :: __unique:__ @test_edgecasesnames_Example_Unsafe_proc@ -} -foreign import ccall unsafe "hs_bindgen_e9cc2037d33041aa" proc' :: +proc' :: IO () +proc' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType proc'_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4a1e741f9ef596ff" rec'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @rec@ @@ -175,8 +216,15 @@ foreign import ccall unsafe "hs_bindgen_e9cc2037d33041aa" proc' :: __unique:__ @test_edgecasesnames_Example_Unsafe_rec@ -} -foreign import ccall unsafe "hs_bindgen_4a1e741f9ef596ff" rec' :: +rec' :: IO () +rec' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType rec'_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ef6f3f22c615db58" using'_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @using@ @@ -186,8 +234,15 @@ foreign import ccall unsafe "hs_bindgen_4a1e741f9ef596ff" rec' :: __unique:__ @test_edgecasesnames_Example_Unsafe_using@ -} -foreign import ccall unsafe "hs_bindgen_ef6f3f22c615db58" using' :: +using' :: IO () +using' = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType using'_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3c7afeaaf3ff040b" anyclass_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @anyclass@ @@ -197,8 +252,15 @@ foreign import ccall unsafe "hs_bindgen_ef6f3f22c615db58" using' :: __unique:__ @test_edgecasesnames_Example_Unsafe_anyclass@ -} -foreign import ccall unsafe "hs_bindgen_3c7afeaaf3ff040b" anyclass :: +anyclass :: IO () +anyclass = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType anyclass_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0518740d4c3caa1d" capi_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @capi@ @@ -208,8 +270,15 @@ foreign import ccall unsafe "hs_bindgen_3c7afeaaf3ff040b" anyclass :: __unique:__ @test_edgecasesnames_Example_Unsafe_capi@ -} -foreign import ccall unsafe "hs_bindgen_0518740d4c3caa1d" capi :: +capi :: IO () +capi = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType capi_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_61f14ad7bb2e3d54" cases_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @cases@ @@ -219,8 +288,15 @@ foreign import ccall unsafe "hs_bindgen_0518740d4c3caa1d" capi :: __unique:__ @test_edgecasesnames_Example_Unsafe_cases@ -} -foreign import ccall unsafe "hs_bindgen_61f14ad7bb2e3d54" cases :: +cases :: IO () +cases = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType cases_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ace8c96ed6673c3b" ccall_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @ccall@ @@ -230,8 +306,15 @@ foreign import ccall unsafe "hs_bindgen_61f14ad7bb2e3d54" cases :: __unique:__ @test_edgecasesnames_Example_Unsafe_ccall@ -} -foreign import ccall unsafe "hs_bindgen_ace8c96ed6673c3b" ccall :: +ccall :: IO () +ccall = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ccall_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8865833b99552d03" dynamic_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @dynamic@ @@ -241,8 +324,15 @@ foreign import ccall unsafe "hs_bindgen_ace8c96ed6673c3b" ccall :: __unique:__ @test_edgecasesnames_Example_Unsafe_dynamic@ -} -foreign import ccall unsafe "hs_bindgen_8865833b99552d03" dynamic :: +dynamic :: IO () +dynamic = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType dynamic_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_15729ba251f5ec57" export_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @export@ @@ -252,8 +342,15 @@ foreign import ccall unsafe "hs_bindgen_8865833b99552d03" dynamic :: __unique:__ @test_edgecasesnames_Example_Unsafe_export@ -} -foreign import ccall unsafe "hs_bindgen_15729ba251f5ec57" export :: +export :: IO () +export = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType export_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e6a4f7e833da2687" family_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @family@ @@ -263,8 +360,15 @@ foreign import ccall unsafe "hs_bindgen_15729ba251f5ec57" export :: __unique:__ @test_edgecasesnames_Example_Unsafe_family@ -} -foreign import ccall unsafe "hs_bindgen_e6a4f7e833da2687" family :: +family :: IO () +family = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType family_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d4dd1bb5e95de858" group_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @group@ @@ -274,8 +378,15 @@ foreign import ccall unsafe "hs_bindgen_e6a4f7e833da2687" family :: __unique:__ @test_edgecasesnames_Example_Unsafe_group@ -} -foreign import ccall unsafe "hs_bindgen_d4dd1bb5e95de858" group :: +group :: IO () +group = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType group_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_516f1ad5aba6de29" interruptible_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @interruptible@ @@ -285,8 +396,15 @@ foreign import ccall unsafe "hs_bindgen_d4dd1bb5e95de858" group :: __unique:__ @test_edgecasesnames_Example_Unsafe_interruptible@ -} -foreign import ccall unsafe "hs_bindgen_516f1ad5aba6de29" interruptible :: +interruptible :: IO () +interruptible = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType interruptible_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_214230db174dc3e6" javascript_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @javascript@ @@ -296,8 +414,15 @@ foreign import ccall unsafe "hs_bindgen_516f1ad5aba6de29" interruptible :: __unique:__ @test_edgecasesnames_Example_Unsafe_javascript@ -} -foreign import ccall unsafe "hs_bindgen_214230db174dc3e6" javascript :: +javascript :: IO () +javascript = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType javascript_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_88f1f0cf9c0f080e" label_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @label@ @@ -307,8 +432,15 @@ foreign import ccall unsafe "hs_bindgen_214230db174dc3e6" javascript :: __unique:__ @test_edgecasesnames_Example_Unsafe_label@ -} -foreign import ccall unsafe "hs_bindgen_88f1f0cf9c0f080e" label :: +label :: IO () +label = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType label_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_93a4c73f587dcf3c" prim_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @prim@ @@ -318,8 +450,15 @@ foreign import ccall unsafe "hs_bindgen_88f1f0cf9c0f080e" label :: __unique:__ @test_edgecasesnames_Example_Unsafe_prim@ -} -foreign import ccall unsafe "hs_bindgen_93a4c73f587dcf3c" prim :: +prim :: IO () +prim = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType prim_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a267fe5585862ecc" role_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @role@ @@ -329,8 +468,15 @@ foreign import ccall unsafe "hs_bindgen_93a4c73f587dcf3c" prim :: __unique:__ @test_edgecasesnames_Example_Unsafe_role@ -} -foreign import ccall unsafe "hs_bindgen_a267fe5585862ecc" role :: +role :: IO () +role = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType role_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ddac4cdf91c756a8" safe_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @safe@ @@ -340,8 +486,15 @@ foreign import ccall unsafe "hs_bindgen_a267fe5585862ecc" role :: __unique:__ @test_edgecasesnames_Example_Unsafe_safe@ -} -foreign import ccall unsafe "hs_bindgen_ddac4cdf91c756a8" safe :: +safe :: IO () +safe = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType safe_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8dd57b02f322a7ae" stdcall_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @stdcall@ @@ -351,8 +504,15 @@ foreign import ccall unsafe "hs_bindgen_ddac4cdf91c756a8" safe :: __unique:__ @test_edgecasesnames_Example_Unsafe_stdcall@ -} -foreign import ccall unsafe "hs_bindgen_8dd57b02f322a7ae" stdcall :: +stdcall :: IO () +stdcall = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType stdcall_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3b69e1860d72507c" stock_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @stock@ @@ -362,8 +522,15 @@ foreign import ccall unsafe "hs_bindgen_8dd57b02f322a7ae" stdcall :: __unique:__ @test_edgecasesnames_Example_Unsafe_stock@ -} -foreign import ccall unsafe "hs_bindgen_3b69e1860d72507c" stock :: +stock :: IO () +stock = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType stock_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b9d80fa39d7ebb06" unsafe_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @unsafe@ @@ -373,8 +540,15 @@ foreign import ccall unsafe "hs_bindgen_3b69e1860d72507c" stock :: __unique:__ @test_edgecasesnames_Example_Unsafe_unsafe@ -} -foreign import ccall unsafe "hs_bindgen_b9d80fa39d7ebb06" unsafe :: +unsafe :: IO () +unsafe = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType unsafe_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_708f6397f5e5ac73" via_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @via@ @@ -384,5 +558,7 @@ foreign import ccall unsafe "hs_bindgen_b9d80fa39d7ebb06" unsafe :: __unique:__ @test_edgecasesnames_Example_Unsafe_via@ -} -foreign import ccall unsafe "hs_bindgen_708f6397f5e5ac73" via :: +via :: IO () +via = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType via_base diff --git a/hs-bindgen/fixtures/edge-cases/names/th.txt b/hs-bindgen/fixtures/edge-cases/names/th.txt index 05632c89a..5d7a9c237 100644 --- a/hs-bindgen/fixtures/edge-cases/names/th.txt +++ b/hs-bindgen/fixtures/edge-cases/names/th.txt @@ -350,6 +350,18 @@ -- { -- return &via; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_601290db9e101424" by'_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @by@ + + __defined at:__ @edge-cases\/names.h:3:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_by@ +-} +by' :: IO Unit {-| __C declaration:__ @by@ __defined at:__ @edge-cases\/names.h:3:6@ @@ -358,7 +370,19 @@ __unique:__ @test_edgecasesnames_Example_Unsafe_by@ -} -foreign import ccall safe "hs_bindgen_601290db9e101424" by' :: IO Unit +by' = fromBaseForeignType by'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f03dbed5eebb711a" forall'_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @forall@ + + __defined at:__ @edge-cases\/names.h:4:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_forall@ +-} +forall' :: IO Unit {-| __C declaration:__ @forall@ __defined at:__ @edge-cases\/names.h:4:6@ @@ -367,7 +391,10 @@ foreign import ccall safe "hs_bindgen_601290db9e101424" by' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_forall@ -} -foreign import ccall safe "hs_bindgen_f03dbed5eebb711a" forall' :: IO Unit +forall' = fromBaseForeignType forall'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d1e3196c869f9fa1" mdo'_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @mdo@ __defined at:__ @edge-cases\/names.h:5:6@ @@ -376,7 +403,28 @@ foreign import ccall safe "hs_bindgen_f03dbed5eebb711a" forall' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_mdo@ -} -foreign import ccall safe "hs_bindgen_d1e3196c869f9fa1" mdo' :: IO Unit +mdo' :: IO Unit +{-| __C declaration:__ @mdo@ + + __defined at:__ @edge-cases\/names.h:5:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_mdo@ +-} +mdo' = fromBaseForeignType mdo'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d3dcd898c88fb2e0" pattern'_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @pattern@ + + __defined at:__ @edge-cases\/names.h:6:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_pattern@ +-} +pattern' :: IO Unit {-| __C declaration:__ @pattern@ __defined at:__ @edge-cases\/names.h:6:6@ @@ -385,7 +433,10 @@ foreign import ccall safe "hs_bindgen_d1e3196c869f9fa1" mdo' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_pattern@ -} -foreign import ccall safe "hs_bindgen_d3dcd898c88fb2e0" pattern' :: IO Unit +pattern' = fromBaseForeignType pattern'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7f08456473f564e3" proc'_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @proc@ __defined at:__ @edge-cases\/names.h:7:6@ @@ -394,7 +445,28 @@ foreign import ccall safe "hs_bindgen_d3dcd898c88fb2e0" pattern' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_proc@ -} -foreign import ccall safe "hs_bindgen_7f08456473f564e3" proc' :: IO Unit +proc' :: IO Unit +{-| __C declaration:__ @proc@ + + __defined at:__ @edge-cases\/names.h:7:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_proc@ +-} +proc' = fromBaseForeignType proc'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5df814c22f546599" rec'_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @rec@ + + __defined at:__ @edge-cases\/names.h:8:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_rec@ +-} +rec' :: IO Unit {-| __C declaration:__ @rec@ __defined at:__ @edge-cases\/names.h:8:6@ @@ -403,7 +475,10 @@ foreign import ccall safe "hs_bindgen_7f08456473f564e3" proc' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_rec@ -} -foreign import ccall safe "hs_bindgen_5df814c22f546599" rec' :: IO Unit +rec' = fromBaseForeignType rec'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3877b6deb653b5a4" using'_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @using@ __defined at:__ @edge-cases\/names.h:9:6@ @@ -412,7 +487,19 @@ foreign import ccall safe "hs_bindgen_5df814c22f546599" rec' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_using@ -} -foreign import ccall safe "hs_bindgen_3877b6deb653b5a4" using' :: IO Unit +using' :: IO Unit +{-| __C declaration:__ @using@ + + __defined at:__ @edge-cases\/names.h:9:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_using@ +-} +using' = fromBaseForeignType using'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7b8790d04357731b" anyclass_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @anyclass@ __defined at:__ @edge-cases\/names.h:12:6@ @@ -421,7 +508,19 @@ foreign import ccall safe "hs_bindgen_3877b6deb653b5a4" using' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_anyclass@ -} -foreign import ccall safe "hs_bindgen_7b8790d04357731b" anyclass :: IO Unit +anyclass :: IO Unit +{-| __C declaration:__ @anyclass@ + + __defined at:__ @edge-cases\/names.h:12:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_anyclass@ +-} +anyclass = fromBaseForeignType anyclass_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0bf4ab515f3279b9" capi_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @capi@ __defined at:__ @edge-cases\/names.h:13:6@ @@ -430,7 +529,28 @@ foreign import ccall safe "hs_bindgen_7b8790d04357731b" anyclass :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_capi@ -} -foreign import ccall safe "hs_bindgen_0bf4ab515f3279b9" capi :: IO Unit +capi :: IO Unit +{-| __C declaration:__ @capi@ + + __defined at:__ @edge-cases\/names.h:13:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_capi@ +-} +capi = fromBaseForeignType capi_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fa8166b2793e4236" cases_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @cases@ + + __defined at:__ @edge-cases\/names.h:14:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_cases@ +-} +cases :: IO Unit {-| __C declaration:__ @cases@ __defined at:__ @edge-cases\/names.h:14:6@ @@ -439,7 +559,10 @@ foreign import ccall safe "hs_bindgen_0bf4ab515f3279b9" capi :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_cases@ -} -foreign import ccall safe "hs_bindgen_fa8166b2793e4236" cases :: IO Unit +cases = fromBaseForeignType cases_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_decc2d43a62d063d" ccall_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @ccall@ __defined at:__ @edge-cases\/names.h:15:6@ @@ -448,7 +571,19 @@ foreign import ccall safe "hs_bindgen_fa8166b2793e4236" cases :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_ccall@ -} -foreign import ccall safe "hs_bindgen_decc2d43a62d063d" ccall :: IO Unit +ccall :: IO Unit +{-| __C declaration:__ @ccall@ + + __defined at:__ @edge-cases\/names.h:15:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_ccall@ +-} +ccall = fromBaseForeignType ccall_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b5a75e2b6434134b" dynamic_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @dynamic@ __defined at:__ @edge-cases\/names.h:16:6@ @@ -457,7 +592,19 @@ foreign import ccall safe "hs_bindgen_decc2d43a62d063d" ccall :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_dynamic@ -} -foreign import ccall safe "hs_bindgen_b5a75e2b6434134b" dynamic :: IO Unit +dynamic :: IO Unit +{-| __C declaration:__ @dynamic@ + + __defined at:__ @edge-cases\/names.h:16:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_dynamic@ +-} +dynamic = fromBaseForeignType dynamic_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_406f7b014573b3d3" export_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @export@ __defined at:__ @edge-cases\/names.h:17:6@ @@ -466,7 +613,19 @@ foreign import ccall safe "hs_bindgen_b5a75e2b6434134b" dynamic :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_export@ -} -foreign import ccall safe "hs_bindgen_406f7b014573b3d3" export :: IO Unit +export :: IO Unit +{-| __C declaration:__ @export@ + + __defined at:__ @edge-cases\/names.h:17:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_export@ +-} +export = fromBaseForeignType export_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_14aab2af04efc222" family_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @family@ __defined at:__ @edge-cases\/names.h:18:6@ @@ -475,7 +634,28 @@ foreign import ccall safe "hs_bindgen_406f7b014573b3d3" export :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_family@ -} -foreign import ccall safe "hs_bindgen_14aab2af04efc222" family :: IO Unit +family :: IO Unit +{-| __C declaration:__ @family@ + + __defined at:__ @edge-cases\/names.h:18:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_family@ +-} +family = fromBaseForeignType family_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ee9285b26b11b393" group_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @group@ + + __defined at:__ @edge-cases\/names.h:19:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_group@ +-} +group :: IO Unit {-| __C declaration:__ @group@ __defined at:__ @edge-cases\/names.h:19:6@ @@ -484,7 +664,19 @@ foreign import ccall safe "hs_bindgen_14aab2af04efc222" family :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_group@ -} -foreign import ccall safe "hs_bindgen_ee9285b26b11b393" group :: IO Unit +group = fromBaseForeignType group_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b2463d5c1d51883e" interruptible_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @interruptible@ + + __defined at:__ @edge-cases\/names.h:20:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_interruptible@ +-} +interruptible :: IO Unit {-| __C declaration:__ @interruptible@ __defined at:__ @edge-cases\/names.h:20:6@ @@ -493,7 +685,19 @@ foreign import ccall safe "hs_bindgen_ee9285b26b11b393" group :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_interruptible@ -} -foreign import ccall safe "hs_bindgen_b2463d5c1d51883e" interruptible :: IO Unit +interruptible = fromBaseForeignType interruptible_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_55a55462d9cd296c" javascript_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @javascript@ + + __defined at:__ @edge-cases\/names.h:21:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_javascript@ +-} +javascript :: IO Unit {-| __C declaration:__ @javascript@ __defined at:__ @edge-cases\/names.h:21:6@ @@ -502,7 +706,10 @@ foreign import ccall safe "hs_bindgen_b2463d5c1d51883e" interruptible :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_javascript@ -} -foreign import ccall safe "hs_bindgen_55a55462d9cd296c" javascript :: IO Unit +javascript = fromBaseForeignType javascript_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_227f34efb176d1fb" label_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @label@ __defined at:__ @edge-cases\/names.h:22:6@ @@ -511,7 +718,19 @@ foreign import ccall safe "hs_bindgen_55a55462d9cd296c" javascript :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_label@ -} -foreign import ccall safe "hs_bindgen_227f34efb176d1fb" label :: IO Unit +label :: IO Unit +{-| __C declaration:__ @label@ + + __defined at:__ @edge-cases\/names.h:22:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_label@ +-} +label = fromBaseForeignType label_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_51c6e0d18dce403a" prim_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @prim@ __defined at:__ @edge-cases\/names.h:23:6@ @@ -520,7 +739,19 @@ foreign import ccall safe "hs_bindgen_227f34efb176d1fb" label :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_prim@ -} -foreign import ccall safe "hs_bindgen_51c6e0d18dce403a" prim :: IO Unit +prim :: IO Unit +{-| __C declaration:__ @prim@ + + __defined at:__ @edge-cases\/names.h:23:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_prim@ +-} +prim = fromBaseForeignType prim_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f85f2418d208e6a0" role_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @role@ __defined at:__ @edge-cases\/names.h:24:6@ @@ -529,7 +760,19 @@ foreign import ccall safe "hs_bindgen_51c6e0d18dce403a" prim :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_role@ -} -foreign import ccall safe "hs_bindgen_f85f2418d208e6a0" role :: IO Unit +role :: IO Unit +{-| __C declaration:__ @role@ + + __defined at:__ @edge-cases\/names.h:24:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_role@ +-} +role = fromBaseForeignType role_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0855ecbc4b53ebbb" safe_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @safe@ __defined at:__ @edge-cases\/names.h:25:6@ @@ -538,7 +781,28 @@ foreign import ccall safe "hs_bindgen_f85f2418d208e6a0" role :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_safe@ -} -foreign import ccall safe "hs_bindgen_0855ecbc4b53ebbb" safe :: IO Unit +safe :: IO Unit +{-| __C declaration:__ @safe@ + + __defined at:__ @edge-cases\/names.h:25:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_safe@ +-} +safe = fromBaseForeignType safe_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e5238d13788a6df9" stdcall_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @stdcall@ + + __defined at:__ @edge-cases\/names.h:26:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_stdcall@ +-} +stdcall :: IO Unit {-| __C declaration:__ @stdcall@ __defined at:__ @edge-cases\/names.h:26:6@ @@ -547,7 +811,19 @@ foreign import ccall safe "hs_bindgen_0855ecbc4b53ebbb" safe :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_stdcall@ -} -foreign import ccall safe "hs_bindgen_e5238d13788a6df9" stdcall :: IO Unit +stdcall = fromBaseForeignType stdcall_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cf38d8bd096a7a42" stock_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @stock@ + + __defined at:__ @edge-cases\/names.h:27:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_stock@ +-} +stock :: IO Unit {-| __C declaration:__ @stock@ __defined at:__ @edge-cases\/names.h:27:6@ @@ -556,7 +832,10 @@ foreign import ccall safe "hs_bindgen_e5238d13788a6df9" stdcall :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_stock@ -} -foreign import ccall safe "hs_bindgen_cf38d8bd096a7a42" stock :: IO Unit +stock = fromBaseForeignType stock_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fda9b083b24404f0" unsafe_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @unsafe@ __defined at:__ @edge-cases\/names.h:28:6@ @@ -565,7 +844,28 @@ foreign import ccall safe "hs_bindgen_cf38d8bd096a7a42" stock :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_unsafe@ -} -foreign import ccall safe "hs_bindgen_fda9b083b24404f0" unsafe :: IO Unit +unsafe :: IO Unit +{-| __C declaration:__ @unsafe@ + + __defined at:__ @edge-cases\/names.h:28:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_unsafe@ +-} +unsafe = fromBaseForeignType unsafe_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1d2a76a3a595be25" via_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @via@ + + __defined at:__ @edge-cases\/names.h:29:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_via@ +-} +via :: IO Unit {-| __C declaration:__ @via@ __defined at:__ @edge-cases\/names.h:29:6@ @@ -574,7 +874,10 @@ foreign import ccall safe "hs_bindgen_fda9b083b24404f0" unsafe :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_via@ -} -foreign import ccall safe "hs_bindgen_1d2a76a3a595be25" via :: IO Unit +via = fromBaseForeignType via_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_28b998af1f39a743" by'_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @by@ __defined at:__ @edge-cases\/names.h:3:6@ @@ -583,7 +886,19 @@ foreign import ccall safe "hs_bindgen_1d2a76a3a595be25" via :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_by@ -} -foreign import ccall safe "hs_bindgen_28b998af1f39a743" by' :: IO Unit +by' :: IO Unit +{-| __C declaration:__ @by@ + + __defined at:__ @edge-cases\/names.h:3:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_by@ +-} +by' = fromBaseForeignType by'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5d7ea7c4d11a5fc8" forall'_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @forall@ __defined at:__ @edge-cases\/names.h:4:6@ @@ -592,7 +907,19 @@ foreign import ccall safe "hs_bindgen_28b998af1f39a743" by' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_forall@ -} -foreign import ccall safe "hs_bindgen_5d7ea7c4d11a5fc8" forall' :: IO Unit +forall' :: IO Unit +{-| __C declaration:__ @forall@ + + __defined at:__ @edge-cases\/names.h:4:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_forall@ +-} +forall' = fromBaseForeignType forall'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2d65448c684c09d5" mdo'_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @mdo@ __defined at:__ @edge-cases\/names.h:5:6@ @@ -601,7 +928,19 @@ foreign import ccall safe "hs_bindgen_5d7ea7c4d11a5fc8" forall' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_mdo@ -} -foreign import ccall safe "hs_bindgen_2d65448c684c09d5" mdo' :: IO Unit +mdo' :: IO Unit +{-| __C declaration:__ @mdo@ + + __defined at:__ @edge-cases\/names.h:5:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_mdo@ +-} +mdo' = fromBaseForeignType mdo'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_13fe653d670d3712" pattern'_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @pattern@ __defined at:__ @edge-cases\/names.h:6:6@ @@ -610,7 +949,28 @@ foreign import ccall safe "hs_bindgen_2d65448c684c09d5" mdo' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_pattern@ -} -foreign import ccall safe "hs_bindgen_13fe653d670d3712" pattern' :: IO Unit +pattern' :: IO Unit +{-| __C declaration:__ @pattern@ + + __defined at:__ @edge-cases\/names.h:6:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_pattern@ +-} +pattern' = fromBaseForeignType pattern'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e9cc2037d33041aa" proc'_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @proc@ + + __defined at:__ @edge-cases\/names.h:7:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_proc@ +-} +proc' :: IO Unit {-| __C declaration:__ @proc@ __defined at:__ @edge-cases\/names.h:7:6@ @@ -619,7 +979,19 @@ foreign import ccall safe "hs_bindgen_13fe653d670d3712" pattern' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_proc@ -} -foreign import ccall safe "hs_bindgen_e9cc2037d33041aa" proc' :: IO Unit +proc' = fromBaseForeignType proc'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4a1e741f9ef596ff" rec'_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @rec@ + + __defined at:__ @edge-cases\/names.h:8:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_rec@ +-} +rec' :: IO Unit {-| __C declaration:__ @rec@ __defined at:__ @edge-cases\/names.h:8:6@ @@ -628,7 +1000,19 @@ foreign import ccall safe "hs_bindgen_e9cc2037d33041aa" proc' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_rec@ -} -foreign import ccall safe "hs_bindgen_4a1e741f9ef596ff" rec' :: IO Unit +rec' = fromBaseForeignType rec'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ef6f3f22c615db58" using'_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @using@ + + __defined at:__ @edge-cases\/names.h:9:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_using@ +-} +using' :: IO Unit {-| __C declaration:__ @using@ __defined at:__ @edge-cases\/names.h:9:6@ @@ -637,7 +1021,19 @@ foreign import ccall safe "hs_bindgen_4a1e741f9ef596ff" rec' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_using@ -} -foreign import ccall safe "hs_bindgen_ef6f3f22c615db58" using' :: IO Unit +using' = fromBaseForeignType using'_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3c7afeaaf3ff040b" anyclass_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @anyclass@ + + __defined at:__ @edge-cases\/names.h:12:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_anyclass@ +-} +anyclass :: IO Unit {-| __C declaration:__ @anyclass@ __defined at:__ @edge-cases\/names.h:12:6@ @@ -646,7 +1042,19 @@ foreign import ccall safe "hs_bindgen_ef6f3f22c615db58" using' :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_anyclass@ -} -foreign import ccall safe "hs_bindgen_3c7afeaaf3ff040b" anyclass :: IO Unit +anyclass = fromBaseForeignType anyclass_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0518740d4c3caa1d" capi_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @capi@ + + __defined at:__ @edge-cases\/names.h:13:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_capi@ +-} +capi :: IO Unit {-| __C declaration:__ @capi@ __defined at:__ @edge-cases\/names.h:13:6@ @@ -655,7 +1063,19 @@ foreign import ccall safe "hs_bindgen_3c7afeaaf3ff040b" anyclass :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_capi@ -} -foreign import ccall safe "hs_bindgen_0518740d4c3caa1d" capi :: IO Unit +capi = fromBaseForeignType capi_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_61f14ad7bb2e3d54" cases_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @cases@ + + __defined at:__ @edge-cases\/names.h:14:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_cases@ +-} +cases :: IO Unit {-| __C declaration:__ @cases@ __defined at:__ @edge-cases\/names.h:14:6@ @@ -664,7 +1084,19 @@ foreign import ccall safe "hs_bindgen_0518740d4c3caa1d" capi :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_cases@ -} -foreign import ccall safe "hs_bindgen_61f14ad7bb2e3d54" cases :: IO Unit +cases = fromBaseForeignType cases_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ace8c96ed6673c3b" ccall_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @ccall@ + + __defined at:__ @edge-cases\/names.h:15:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_ccall@ +-} +ccall :: IO Unit {-| __C declaration:__ @ccall@ __defined at:__ @edge-cases\/names.h:15:6@ @@ -673,7 +1105,19 @@ foreign import ccall safe "hs_bindgen_61f14ad7bb2e3d54" cases :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_ccall@ -} -foreign import ccall safe "hs_bindgen_ace8c96ed6673c3b" ccall :: IO Unit +ccall = fromBaseForeignType ccall_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8865833b99552d03" dynamic_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @dynamic@ + + __defined at:__ @edge-cases\/names.h:16:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_dynamic@ +-} +dynamic :: IO Unit {-| __C declaration:__ @dynamic@ __defined at:__ @edge-cases\/names.h:16:6@ @@ -682,7 +1126,19 @@ foreign import ccall safe "hs_bindgen_ace8c96ed6673c3b" ccall :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_dynamic@ -} -foreign import ccall safe "hs_bindgen_8865833b99552d03" dynamic :: IO Unit +dynamic = fromBaseForeignType dynamic_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_15729ba251f5ec57" export_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @export@ + + __defined at:__ @edge-cases\/names.h:17:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_export@ +-} +export :: IO Unit {-| __C declaration:__ @export@ __defined at:__ @edge-cases\/names.h:17:6@ @@ -691,7 +1147,19 @@ foreign import ccall safe "hs_bindgen_8865833b99552d03" dynamic :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_export@ -} -foreign import ccall safe "hs_bindgen_15729ba251f5ec57" export :: IO Unit +export = fromBaseForeignType export_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e6a4f7e833da2687" family_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @family@ + + __defined at:__ @edge-cases\/names.h:18:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_family@ +-} +family :: IO Unit {-| __C declaration:__ @family@ __defined at:__ @edge-cases\/names.h:18:6@ @@ -700,7 +1168,19 @@ foreign import ccall safe "hs_bindgen_15729ba251f5ec57" export :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_family@ -} -foreign import ccall safe "hs_bindgen_e6a4f7e833da2687" family :: IO Unit +family = fromBaseForeignType family_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d4dd1bb5e95de858" group_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @group@ + + __defined at:__ @edge-cases\/names.h:19:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_group@ +-} +group :: IO Unit {-| __C declaration:__ @group@ __defined at:__ @edge-cases\/names.h:19:6@ @@ -709,7 +1189,19 @@ foreign import ccall safe "hs_bindgen_e6a4f7e833da2687" family :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_group@ -} -foreign import ccall safe "hs_bindgen_d4dd1bb5e95de858" group :: IO Unit +group = fromBaseForeignType group_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_516f1ad5aba6de29" interruptible_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @interruptible@ + + __defined at:__ @edge-cases\/names.h:20:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_interruptible@ +-} +interruptible :: IO Unit {-| __C declaration:__ @interruptible@ __defined at:__ @edge-cases\/names.h:20:6@ @@ -718,7 +1210,19 @@ foreign import ccall safe "hs_bindgen_d4dd1bb5e95de858" group :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_interruptible@ -} -foreign import ccall safe "hs_bindgen_516f1ad5aba6de29" interruptible :: IO Unit +interruptible = fromBaseForeignType interruptible_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_214230db174dc3e6" javascript_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @javascript@ + + __defined at:__ @edge-cases\/names.h:21:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_javascript@ +-} +javascript :: IO Unit {-| __C declaration:__ @javascript@ __defined at:__ @edge-cases\/names.h:21:6@ @@ -727,7 +1231,19 @@ foreign import ccall safe "hs_bindgen_516f1ad5aba6de29" interruptible :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_javascript@ -} -foreign import ccall safe "hs_bindgen_214230db174dc3e6" javascript :: IO Unit +javascript = fromBaseForeignType javascript_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_88f1f0cf9c0f080e" label_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @label@ + + __defined at:__ @edge-cases\/names.h:22:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_label@ +-} +label :: IO Unit {-| __C declaration:__ @label@ __defined at:__ @edge-cases\/names.h:22:6@ @@ -736,7 +1252,19 @@ foreign import ccall safe "hs_bindgen_214230db174dc3e6" javascript :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_label@ -} -foreign import ccall safe "hs_bindgen_88f1f0cf9c0f080e" label :: IO Unit +label = fromBaseForeignType label_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_93a4c73f587dcf3c" prim_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @prim@ + + __defined at:__ @edge-cases\/names.h:23:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_prim@ +-} +prim :: IO Unit {-| __C declaration:__ @prim@ __defined at:__ @edge-cases\/names.h:23:6@ @@ -745,7 +1273,10 @@ foreign import ccall safe "hs_bindgen_88f1f0cf9c0f080e" label :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_prim@ -} -foreign import ccall safe "hs_bindgen_93a4c73f587dcf3c" prim :: IO Unit +prim = fromBaseForeignType prim_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a267fe5585862ecc" role_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @role@ __defined at:__ @edge-cases\/names.h:24:6@ @@ -754,7 +1285,28 @@ foreign import ccall safe "hs_bindgen_93a4c73f587dcf3c" prim :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_role@ -} -foreign import ccall safe "hs_bindgen_a267fe5585862ecc" role :: IO Unit +role :: IO Unit +{-| __C declaration:__ @role@ + + __defined at:__ @edge-cases\/names.h:24:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_role@ +-} +role = fromBaseForeignType role_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ddac4cdf91c756a8" safe_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @safe@ + + __defined at:__ @edge-cases\/names.h:25:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_safe@ +-} +safe :: IO Unit {-| __C declaration:__ @safe@ __defined at:__ @edge-cases\/names.h:25:6@ @@ -763,7 +1315,19 @@ foreign import ccall safe "hs_bindgen_a267fe5585862ecc" role :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_safe@ -} -foreign import ccall safe "hs_bindgen_ddac4cdf91c756a8" safe :: IO Unit +safe = fromBaseForeignType safe_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8dd57b02f322a7ae" stdcall_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @stdcall@ + + __defined at:__ @edge-cases\/names.h:26:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_stdcall@ +-} +stdcall :: IO Unit {-| __C declaration:__ @stdcall@ __defined at:__ @edge-cases\/names.h:26:6@ @@ -772,7 +1336,19 @@ foreign import ccall safe "hs_bindgen_ddac4cdf91c756a8" safe :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_stdcall@ -} -foreign import ccall safe "hs_bindgen_8dd57b02f322a7ae" stdcall :: IO Unit +stdcall = fromBaseForeignType stdcall_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3b69e1860d72507c" stock_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @stock@ + + __defined at:__ @edge-cases\/names.h:27:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_stock@ +-} +stock :: IO Unit {-| __C declaration:__ @stock@ __defined at:__ @edge-cases\/names.h:27:6@ @@ -781,7 +1357,19 @@ foreign import ccall safe "hs_bindgen_8dd57b02f322a7ae" stdcall :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_stock@ -} -foreign import ccall safe "hs_bindgen_3b69e1860d72507c" stock :: IO Unit +stock = fromBaseForeignType stock_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b9d80fa39d7ebb06" unsafe_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @unsafe@ + + __defined at:__ @edge-cases\/names.h:28:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_unsafe@ +-} +unsafe :: IO Unit {-| __C declaration:__ @unsafe@ __defined at:__ @edge-cases\/names.h:28:6@ @@ -790,7 +1378,19 @@ foreign import ccall safe "hs_bindgen_3b69e1860d72507c" stock :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_unsafe@ -} -foreign import ccall safe "hs_bindgen_b9d80fa39d7ebb06" unsafe :: IO Unit +unsafe = fromBaseForeignType unsafe_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_708f6397f5e5ac73" via_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @via@ + + __defined at:__ @edge-cases\/names.h:29:6@ + + __exported by:__ @edge-cases\/names.h@ + + __unique:__ @test_edgecasesnames_Example_Unsafe_via@ +-} +via :: IO Unit {-| __C declaration:__ @via@ __defined at:__ @edge-cases\/names.h:29:6@ @@ -799,10 +1399,16 @@ foreign import ccall safe "hs_bindgen_b9d80fa39d7ebb06" unsafe :: IO Unit __unique:__ @test_edgecasesnames_Example_Unsafe_via@ -} -foreign import ccall safe "hs_bindgen_708f6397f5e5ac73" via :: IO Unit +via = fromBaseForeignType via_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6974dc9d1fd9efdb" hs_bindgen_6974dc9d1fd9efdb_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_by_ptr@ +-} +hs_bindgen_6974dc9d1fd9efdb :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_by_ptr@ -} -foreign import ccall safe "hs_bindgen_6974dc9d1fd9efdb" hs_bindgen_6974dc9d1fd9efdb :: IO (FunPtr (IO Unit)) +hs_bindgen_6974dc9d1fd9efdb = fromBaseForeignType hs_bindgen_6974dc9d1fd9efdb_base {-# NOINLINE by'_ptr #-} {-| __C declaration:__ @by@ @@ -818,9 +1424,15 @@ by'_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} by'_ptr = unsafePerformIO hs_bindgen_6974dc9d1fd9efdb +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3b643ea94c4ffa20" hs_bindgen_3b643ea94c4ffa20_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_forall_ptr@ +-} +hs_bindgen_3b643ea94c4ffa20 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_forall_ptr@ -} -foreign import ccall safe "hs_bindgen_3b643ea94c4ffa20" hs_bindgen_3b643ea94c4ffa20 :: IO (FunPtr (IO Unit)) +hs_bindgen_3b643ea94c4ffa20 = fromBaseForeignType hs_bindgen_3b643ea94c4ffa20_base {-# NOINLINE forall'_ptr #-} {-| __C declaration:__ @forall@ @@ -836,9 +1448,15 @@ forall'_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} forall'_ptr = unsafePerformIO hs_bindgen_3b643ea94c4ffa20 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_75a958dcb6aa760d" hs_bindgen_75a958dcb6aa760d_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_edgecasesnames_Example_get_mdo_ptr@ -} -foreign import ccall safe "hs_bindgen_75a958dcb6aa760d" hs_bindgen_75a958dcb6aa760d :: IO (FunPtr (IO Unit)) +hs_bindgen_75a958dcb6aa760d :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_edgecasesnames_Example_get_mdo_ptr@ +-} +hs_bindgen_75a958dcb6aa760d = fromBaseForeignType hs_bindgen_75a958dcb6aa760d_base {-# NOINLINE mdo'_ptr #-} {-| __C declaration:__ @mdo@ @@ -854,9 +1472,15 @@ mdo'_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} mdo'_ptr = unsafePerformIO hs_bindgen_75a958dcb6aa760d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2dca22d927c6b6c9" hs_bindgen_2dca22d927c6b6c9_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_pattern_ptr@ +-} +hs_bindgen_2dca22d927c6b6c9 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_pattern_ptr@ -} -foreign import ccall safe "hs_bindgen_2dca22d927c6b6c9" hs_bindgen_2dca22d927c6b6c9 :: IO (FunPtr (IO Unit)) +hs_bindgen_2dca22d927c6b6c9 = fromBaseForeignType hs_bindgen_2dca22d927c6b6c9_base {-# NOINLINE pattern'_ptr #-} {-| __C declaration:__ @pattern@ @@ -872,9 +1496,15 @@ pattern'_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} pattern'_ptr = unsafePerformIO hs_bindgen_2dca22d927c6b6c9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_278f3b1df8a83886" hs_bindgen_278f3b1df8a83886_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_proc_ptr@ +-} +hs_bindgen_278f3b1df8a83886 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_proc_ptr@ -} -foreign import ccall safe "hs_bindgen_278f3b1df8a83886" hs_bindgen_278f3b1df8a83886 :: IO (FunPtr (IO Unit)) +hs_bindgen_278f3b1df8a83886 = fromBaseForeignType hs_bindgen_278f3b1df8a83886_base {-# NOINLINE proc'_ptr #-} {-| __C declaration:__ @proc@ @@ -890,9 +1520,15 @@ proc'_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} proc'_ptr = unsafePerformIO hs_bindgen_278f3b1df8a83886 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3be0a960ee51c3e9" hs_bindgen_3be0a960ee51c3e9_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_rec_ptr@ +-} +hs_bindgen_3be0a960ee51c3e9 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_rec_ptr@ -} -foreign import ccall safe "hs_bindgen_3be0a960ee51c3e9" hs_bindgen_3be0a960ee51c3e9 :: IO (FunPtr (IO Unit)) +hs_bindgen_3be0a960ee51c3e9 = fromBaseForeignType hs_bindgen_3be0a960ee51c3e9_base {-# NOINLINE rec'_ptr #-} {-| __C declaration:__ @rec@ @@ -908,9 +1544,15 @@ rec'_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} rec'_ptr = unsafePerformIO hs_bindgen_3be0a960ee51c3e9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_84e44d3bf799af26" hs_bindgen_84e44d3bf799af26_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_edgecasesnames_Example_get_using_ptr@ -} -foreign import ccall safe "hs_bindgen_84e44d3bf799af26" hs_bindgen_84e44d3bf799af26 :: IO (FunPtr (IO Unit)) +hs_bindgen_84e44d3bf799af26 :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_edgecasesnames_Example_get_using_ptr@ +-} +hs_bindgen_84e44d3bf799af26 = fromBaseForeignType hs_bindgen_84e44d3bf799af26_base {-# NOINLINE using'_ptr #-} {-| __C declaration:__ @using@ @@ -926,9 +1568,15 @@ using'_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} using'_ptr = unsafePerformIO hs_bindgen_84e44d3bf799af26 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_95cf172ae2160046" hs_bindgen_95cf172ae2160046_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_anyclass_ptr@ +-} +hs_bindgen_95cf172ae2160046 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_anyclass_ptr@ -} -foreign import ccall safe "hs_bindgen_95cf172ae2160046" hs_bindgen_95cf172ae2160046 :: IO (FunPtr (IO Unit)) +hs_bindgen_95cf172ae2160046 = fromBaseForeignType hs_bindgen_95cf172ae2160046_base {-# NOINLINE anyclass_ptr #-} {-| __C declaration:__ @anyclass@ @@ -944,9 +1592,15 @@ anyclass_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} anyclass_ptr = unsafePerformIO hs_bindgen_95cf172ae2160046 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ea4d99f6c2e96742" hs_bindgen_ea4d99f6c2e96742_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_capi_ptr@ +-} +hs_bindgen_ea4d99f6c2e96742 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_capi_ptr@ -} -foreign import ccall safe "hs_bindgen_ea4d99f6c2e96742" hs_bindgen_ea4d99f6c2e96742 :: IO (FunPtr (IO Unit)) +hs_bindgen_ea4d99f6c2e96742 = fromBaseForeignType hs_bindgen_ea4d99f6c2e96742_base {-# NOINLINE capi_ptr #-} {-| __C declaration:__ @capi@ @@ -962,9 +1616,15 @@ capi_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} capi_ptr = unsafePerformIO hs_bindgen_ea4d99f6c2e96742 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aff69f10c4c30a0d" hs_bindgen_aff69f10c4c30a0d_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_cases_ptr@ +-} +hs_bindgen_aff69f10c4c30a0d :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_cases_ptr@ -} -foreign import ccall safe "hs_bindgen_aff69f10c4c30a0d" hs_bindgen_aff69f10c4c30a0d :: IO (FunPtr (IO Unit)) +hs_bindgen_aff69f10c4c30a0d = fromBaseForeignType hs_bindgen_aff69f10c4c30a0d_base {-# NOINLINE cases_ptr #-} {-| __C declaration:__ @cases@ @@ -980,9 +1640,15 @@ cases_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} cases_ptr = unsafePerformIO hs_bindgen_aff69f10c4c30a0d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f5db0ca2d6dce4d5" hs_bindgen_f5db0ca2d6dce4d5_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_edgecasesnames_Example_get_ccall_ptr@ -} -foreign import ccall safe "hs_bindgen_f5db0ca2d6dce4d5" hs_bindgen_f5db0ca2d6dce4d5 :: IO (FunPtr (IO Unit)) +hs_bindgen_f5db0ca2d6dce4d5 :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_edgecasesnames_Example_get_ccall_ptr@ +-} +hs_bindgen_f5db0ca2d6dce4d5 = fromBaseForeignType hs_bindgen_f5db0ca2d6dce4d5_base {-# NOINLINE ccall_ptr #-} {-| __C declaration:__ @ccall@ @@ -998,9 +1664,15 @@ ccall_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} ccall_ptr = unsafePerformIO hs_bindgen_f5db0ca2d6dce4d5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d5e3711b7b2f435e" hs_bindgen_d5e3711b7b2f435e_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_dynamic_ptr@ +-} +hs_bindgen_d5e3711b7b2f435e :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_dynamic_ptr@ -} -foreign import ccall safe "hs_bindgen_d5e3711b7b2f435e" hs_bindgen_d5e3711b7b2f435e :: IO (FunPtr (IO Unit)) +hs_bindgen_d5e3711b7b2f435e = fromBaseForeignType hs_bindgen_d5e3711b7b2f435e_base {-# NOINLINE dynamic_ptr #-} {-| __C declaration:__ @dynamic@ @@ -1016,9 +1688,15 @@ dynamic_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} dynamic_ptr = unsafePerformIO hs_bindgen_d5e3711b7b2f435e +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c3e4c5611dd8ffdf" hs_bindgen_c3e4c5611dd8ffdf_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_export_ptr@ +-} +hs_bindgen_c3e4c5611dd8ffdf :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_export_ptr@ -} -foreign import ccall safe "hs_bindgen_c3e4c5611dd8ffdf" hs_bindgen_c3e4c5611dd8ffdf :: IO (FunPtr (IO Unit)) +hs_bindgen_c3e4c5611dd8ffdf = fromBaseForeignType hs_bindgen_c3e4c5611dd8ffdf_base {-# NOINLINE export_ptr #-} {-| __C declaration:__ @export@ @@ -1034,9 +1712,15 @@ export_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} export_ptr = unsafePerformIO hs_bindgen_c3e4c5611dd8ffdf +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_658a25f6c844805b" hs_bindgen_658a25f6c844805b_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_family_ptr@ +-} +hs_bindgen_658a25f6c844805b :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_family_ptr@ -} -foreign import ccall safe "hs_bindgen_658a25f6c844805b" hs_bindgen_658a25f6c844805b :: IO (FunPtr (IO Unit)) +hs_bindgen_658a25f6c844805b = fromBaseForeignType hs_bindgen_658a25f6c844805b_base {-# NOINLINE family_ptr #-} {-| __C declaration:__ @family@ @@ -1052,9 +1736,15 @@ family_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} family_ptr = unsafePerformIO hs_bindgen_658a25f6c844805b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0c7fb62fb95f0f38" hs_bindgen_0c7fb62fb95f0f38_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_edgecasesnames_Example_get_group_ptr@ -} -foreign import ccall safe "hs_bindgen_0c7fb62fb95f0f38" hs_bindgen_0c7fb62fb95f0f38 :: IO (FunPtr (IO Unit)) +hs_bindgen_0c7fb62fb95f0f38 :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_edgecasesnames_Example_get_group_ptr@ +-} +hs_bindgen_0c7fb62fb95f0f38 = fromBaseForeignType hs_bindgen_0c7fb62fb95f0f38_base {-# NOINLINE group_ptr #-} {-| __C declaration:__ @group@ @@ -1070,9 +1760,15 @@ group_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} group_ptr = unsafePerformIO hs_bindgen_0c7fb62fb95f0f38 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bb9472bbc501c78f" hs_bindgen_bb9472bbc501c78f_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_interruptible_ptr@ +-} +hs_bindgen_bb9472bbc501c78f :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_interruptible_ptr@ -} -foreign import ccall safe "hs_bindgen_bb9472bbc501c78f" hs_bindgen_bb9472bbc501c78f :: IO (FunPtr (IO Unit)) +hs_bindgen_bb9472bbc501c78f = fromBaseForeignType hs_bindgen_bb9472bbc501c78f_base {-# NOINLINE interruptible_ptr #-} {-| __C declaration:__ @interruptible@ @@ -1088,9 +1784,15 @@ interruptible_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} interruptible_ptr = unsafePerformIO hs_bindgen_bb9472bbc501c78f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0c7eeee673af7865" hs_bindgen_0c7eeee673af7865_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_javascript_ptr@ +-} +hs_bindgen_0c7eeee673af7865 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_javascript_ptr@ -} -foreign import ccall safe "hs_bindgen_0c7eeee673af7865" hs_bindgen_0c7eeee673af7865 :: IO (FunPtr (IO Unit)) +hs_bindgen_0c7eeee673af7865 = fromBaseForeignType hs_bindgen_0c7eeee673af7865_base {-# NOINLINE javascript_ptr #-} {-| __C declaration:__ @javascript@ @@ -1106,9 +1808,15 @@ javascript_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} javascript_ptr = unsafePerformIO hs_bindgen_0c7eeee673af7865 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d16291c6c6c905ab" hs_bindgen_d16291c6c6c905ab_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_label_ptr@ +-} +hs_bindgen_d16291c6c6c905ab :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_label_ptr@ -} -foreign import ccall safe "hs_bindgen_d16291c6c6c905ab" hs_bindgen_d16291c6c6c905ab :: IO (FunPtr (IO Unit)) +hs_bindgen_d16291c6c6c905ab = fromBaseForeignType hs_bindgen_d16291c6c6c905ab_base {-# NOINLINE label_ptr #-} {-| __C declaration:__ @label@ @@ -1124,9 +1832,15 @@ label_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} label_ptr = unsafePerformIO hs_bindgen_d16291c6c6c905ab +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0657843e52c044fe" hs_bindgen_0657843e52c044fe_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_edgecasesnames_Example_get_prim_ptr@ -} -foreign import ccall safe "hs_bindgen_0657843e52c044fe" hs_bindgen_0657843e52c044fe :: IO (FunPtr (IO Unit)) +hs_bindgen_0657843e52c044fe :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_edgecasesnames_Example_get_prim_ptr@ +-} +hs_bindgen_0657843e52c044fe = fromBaseForeignType hs_bindgen_0657843e52c044fe_base {-# NOINLINE prim_ptr #-} {-| __C declaration:__ @prim@ @@ -1142,9 +1856,15 @@ prim_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} prim_ptr = unsafePerformIO hs_bindgen_0657843e52c044fe +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bdbcb244d39fa251" hs_bindgen_bdbcb244d39fa251_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_role_ptr@ +-} +hs_bindgen_bdbcb244d39fa251 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_role_ptr@ -} -foreign import ccall safe "hs_bindgen_bdbcb244d39fa251" hs_bindgen_bdbcb244d39fa251 :: IO (FunPtr (IO Unit)) +hs_bindgen_bdbcb244d39fa251 = fromBaseForeignType hs_bindgen_bdbcb244d39fa251_base {-# NOINLINE role_ptr #-} {-| __C declaration:__ @role@ @@ -1160,9 +1880,15 @@ role_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} role_ptr = unsafePerformIO hs_bindgen_bdbcb244d39fa251 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_400c28e571f13194" hs_bindgen_400c28e571f13194_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_safe_ptr@ +-} +hs_bindgen_400c28e571f13194 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_safe_ptr@ -} -foreign import ccall safe "hs_bindgen_400c28e571f13194" hs_bindgen_400c28e571f13194 :: IO (FunPtr (IO Unit)) +hs_bindgen_400c28e571f13194 = fromBaseForeignType hs_bindgen_400c28e571f13194_base {-# NOINLINE safe_ptr #-} {-| __C declaration:__ @safe@ @@ -1178,9 +1904,15 @@ safe_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} safe_ptr = unsafePerformIO hs_bindgen_400c28e571f13194 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_15aff4a3542e1023" hs_bindgen_15aff4a3542e1023_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_stdcall_ptr@ +-} +hs_bindgen_15aff4a3542e1023 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_stdcall_ptr@ -} -foreign import ccall safe "hs_bindgen_15aff4a3542e1023" hs_bindgen_15aff4a3542e1023 :: IO (FunPtr (IO Unit)) +hs_bindgen_15aff4a3542e1023 = fromBaseForeignType hs_bindgen_15aff4a3542e1023_base {-# NOINLINE stdcall_ptr #-} {-| __C declaration:__ @stdcall@ @@ -1196,9 +1928,15 @@ stdcall_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} stdcall_ptr = unsafePerformIO hs_bindgen_15aff4a3542e1023 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9df7dc3f71a3ab76" hs_bindgen_9df7dc3f71a3ab76_base :: BaseForeignType (IO (FunPtr (IO Unit))) {-| __unique:__ @test_edgecasesnames_Example_get_stock_ptr@ -} -foreign import ccall safe "hs_bindgen_9df7dc3f71a3ab76" hs_bindgen_9df7dc3f71a3ab76 :: IO (FunPtr (IO Unit)) +hs_bindgen_9df7dc3f71a3ab76 :: IO (FunPtr (IO Unit)) +{-| __unique:__ @test_edgecasesnames_Example_get_stock_ptr@ +-} +hs_bindgen_9df7dc3f71a3ab76 = fromBaseForeignType hs_bindgen_9df7dc3f71a3ab76_base {-# NOINLINE stock_ptr #-} {-| __C declaration:__ @stock@ @@ -1214,9 +1952,15 @@ stock_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} stock_ptr = unsafePerformIO hs_bindgen_9df7dc3f71a3ab76 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aebb5b55a2d78a79" hs_bindgen_aebb5b55a2d78a79_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_unsafe_ptr@ +-} +hs_bindgen_aebb5b55a2d78a79 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_unsafe_ptr@ -} -foreign import ccall safe "hs_bindgen_aebb5b55a2d78a79" hs_bindgen_aebb5b55a2d78a79 :: IO (FunPtr (IO Unit)) +hs_bindgen_aebb5b55a2d78a79 = fromBaseForeignType hs_bindgen_aebb5b55a2d78a79_base {-# NOINLINE unsafe_ptr #-} {-| __C declaration:__ @unsafe@ @@ -1232,9 +1976,15 @@ unsafe_ptr :: FunPtr (IO Unit) __exported by:__ @edge-cases\/names.h@ -} unsafe_ptr = unsafePerformIO hs_bindgen_aebb5b55a2d78a79 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c6fe1f3a125fa32d" hs_bindgen_c6fe1f3a125fa32d_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_edgecasesnames_Example_get_via_ptr@ +-} +hs_bindgen_c6fe1f3a125fa32d :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_edgecasesnames_Example_get_via_ptr@ -} -foreign import ccall safe "hs_bindgen_c6fe1f3a125fa32d" hs_bindgen_c6fe1f3a125fa32d :: IO (FunPtr (IO Unit)) +hs_bindgen_c6fe1f3a125fa32d = fromBaseForeignType hs_bindgen_c6fe1f3a125fa32d_base {-# NOINLINE via_ptr #-} {-| __C declaration:__ @via@ diff --git a/hs-bindgen/fixtures/edge-cases/spec_examples/Example/FunPtr.hs b/hs-bindgen/fixtures/edge-cases/spec_examples/Example/FunPtr.hs index 44d1fdcb8..a8628c880 100644 --- a/hs-bindgen/fixtures/edge-cases/spec_examples/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/edge-cases/spec_examples/Example/FunPtr.hs @@ -9,6 +9,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -29,10 +30,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c940a9562d0838b1" hs_bindgen_c940a9562d0838b1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Int32_T) -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 30720000) Cint16_T) -> Int64_T -> Int64_T -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 30720000) Cint16_T) -> IO ()))) + {-| __unique:__ @test_edgecasesspec_examples_Example_get_resample_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c940a9562d0838b1" hs_bindgen_c940a9562d0838b1 :: +hs_bindgen_c940a9562d0838b1 :: IO (Ptr.FunPtr ((Ptr.Ptr Int32_T) -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 30720000) Cint16_T) -> Int64_T -> Int64_T -> ((HsBindgen.Runtime.ConstantArray.ConstantArray 30720000) Cint16_T) -> IO ())) +hs_bindgen_c940a9562d0838b1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c940a9562d0838b1_base {-# NOINLINE resample_ptr #-} diff --git a/hs-bindgen/fixtures/edge-cases/spec_examples/Example/Safe.hs b/hs-bindgen/fixtures/edge-cases/spec_examples/Example/Safe.hs index 553f0ad54..94826b5c7 100644 --- a/hs-bindgen/fixtures/edge-cases/spec_examples/Example/Safe.hs +++ b/hs-bindgen/fixtures/edge-cases/spec_examples/Example/Safe.hs @@ -6,6 +6,7 @@ module Example.Safe where import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -24,6 +25,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8a72aafc705daf44" resample_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Int32_T) -> (Ptr.Ptr Cint16_T) -> Int64_T -> Int64_T -> (Ptr.Ptr Cint16_T) -> IO ()) + {-| __C declaration:__ @resample@ __defined at:__ @edge-cases\/spec_examples.h:31:6@ @@ -32,7 +38,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesspec_examples_Example_Safe_resample@ -} -foreign import ccall safe "hs_bindgen_8a72aafc705daf44" resample :: +resample :: Ptr.Ptr Int32_T {- ^ __C declaration:__ @res_m_num_valid_samples@ -} @@ -49,3 +55,5 @@ foreign import ccall safe "hs_bindgen_8a72aafc705daf44" resample :: {- ^ __C declaration:__ @res_m_iq_resampled_int@ -} -> IO () +resample = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType resample_base diff --git a/hs-bindgen/fixtures/edge-cases/spec_examples/Example/Unsafe.hs b/hs-bindgen/fixtures/edge-cases/spec_examples/Example/Unsafe.hs index 55a9376e3..4b65def41 100644 --- a/hs-bindgen/fixtures/edge-cases/spec_examples/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/edge-cases/spec_examples/Example/Unsafe.hs @@ -6,6 +6,7 @@ module Example.Unsafe where import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -24,6 +25,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2311fa9c0d0d6d06" resample_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Int32_T) -> (Ptr.Ptr Cint16_T) -> Int64_T -> Int64_T -> (Ptr.Ptr Cint16_T) -> IO ()) + {-| __C declaration:__ @resample@ __defined at:__ @edge-cases\/spec_examples.h:31:6@ @@ -32,7 +38,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_edgecasesspec_examples_Example_Unsafe_resample@ -} -foreign import ccall unsafe "hs_bindgen_2311fa9c0d0d6d06" resample :: +resample :: Ptr.Ptr Int32_T {- ^ __C declaration:__ @res_m_num_valid_samples@ -} @@ -49,3 +55,5 @@ foreign import ccall unsafe "hs_bindgen_2311fa9c0d0d6d06" resample :: {- ^ __C declaration:__ @res_m_iq_resampled_int@ -} -> IO () +resample = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType resample_base diff --git a/hs-bindgen/fixtures/edge-cases/spec_examples/th.txt b/hs-bindgen/fixtures/edge-cases/spec_examples/th.txt index 526d09519..a03e64c17 100644 --- a/hs-bindgen/fixtures/edge-cases/spec_examples/th.txt +++ b/hs-bindgen/fixtures/edge-cases/spec_examples/th.txt @@ -289,6 +289,14 @@ instance TyEq ty (CFieldType A "a_c") => __exported by:__ @edge-cases\/spec_examples.h@ -} data C +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8a72aafc705daf44" resample_base :: BaseForeignType (Ptr Int32_T -> + Ptr Cint16_T -> + Int64_T -> + Int64_T -> + Ptr Cint16_T -> + IO Unit) {-| __C declaration:__ @resample@ __defined at:__ @edge-cases\/spec_examples.h:31:6@ @@ -297,11 +305,8 @@ data C __unique:__ @test_edgecasesspec_examples_Example_Unsafe_resample@ -} -foreign import ccall safe "hs_bindgen_8a72aafc705daf44" resample :: Ptr Int32_T -> - Ptr Cint16_T -> - Int64_T -> - Int64_T -> - Ptr Cint16_T -> IO Unit +resample :: Ptr Int32_T -> + Ptr Cint16_T -> Int64_T -> Int64_T -> Ptr Cint16_T -> IO Unit {-| __C declaration:__ @resample@ __defined at:__ @edge-cases\/spec_examples.h:31:6@ @@ -310,21 +315,53 @@ foreign import ccall safe "hs_bindgen_8a72aafc705daf44" resample :: Ptr Int32_T __unique:__ @test_edgecasesspec_examples_Example_Unsafe_resample@ -} -foreign import ccall safe "hs_bindgen_2311fa9c0d0d6d06" resample :: Ptr Int32_T -> - Ptr Cint16_T -> - Int64_T -> - Int64_T -> - Ptr Cint16_T -> IO Unit +resample = fromBaseForeignType resample_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2311fa9c0d0d6d06" resample_base :: BaseForeignType (Ptr Int32_T -> + Ptr Cint16_T -> + Int64_T -> + Int64_T -> + Ptr Cint16_T -> + IO Unit) +{-| __C declaration:__ @resample@ + + __defined at:__ @edge-cases\/spec_examples.h:31:6@ + + __exported by:__ @edge-cases\/spec_examples.h@ + + __unique:__ @test_edgecasesspec_examples_Example_Unsafe_resample@ +-} +resample :: Ptr Int32_T -> + Ptr Cint16_T -> Int64_T -> Int64_T -> Ptr Cint16_T -> IO Unit +{-| __C declaration:__ @resample@ + + __defined at:__ @edge-cases\/spec_examples.h:31:6@ + + __exported by:__ @edge-cases\/spec_examples.h@ + + __unique:__ @test_edgecasesspec_examples_Example_Unsafe_resample@ +-} +resample = fromBaseForeignType resample_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c940a9562d0838b1" hs_bindgen_c940a9562d0838b1_base :: BaseForeignType (IO (FunPtr (Ptr Int32_T -> + ConstantArray 30720000 + Cint16_T -> + Int64_T -> + Int64_T -> + ConstantArray 30720000 + Cint16_T -> + IO Unit))) +{-| __unique:__ @test_edgecasesspec_examples_Example_get_resample_ptr@ +-} +hs_bindgen_c940a9562d0838b1 :: IO (FunPtr (Ptr Int32_T -> + ConstantArray 30720000 Cint16_T -> + Int64_T -> + Int64_T -> ConstantArray 30720000 Cint16_T -> IO Unit)) {-| __unique:__ @test_edgecasesspec_examples_Example_get_resample_ptr@ -} -foreign import ccall safe "hs_bindgen_c940a9562d0838b1" hs_bindgen_c940a9562d0838b1 :: IO (FunPtr (Ptr Int32_T -> - ConstantArray 30720000 - Cint16_T -> - Int64_T -> - Int64_T -> - ConstantArray 30720000 - Cint16_T -> - IO Unit)) +hs_bindgen_c940a9562d0838b1 = fromBaseForeignType hs_bindgen_c940a9562d0838b1_base {-# NOINLINE resample_ptr #-} {-| __C declaration:__ @resample@ diff --git a/hs-bindgen/fixtures/functions/callbacks/Example/FunPtr.hs b/hs-bindgen/fixtures/functions/callbacks/Example/FunPtr.hs index dbbb483f8..806d5a35c 100644 --- a/hs-bindgen/fixtures/functions/callbacks/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/functions/callbacks/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -178,10 +179,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_11c3318ecc076134" hs_bindgen_11c3318ecc076134_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_functionscallbacks_Example_get_readFileWithProcessor_ptr@ -} -foreign import ccall unsafe "hs_bindgen_11c3318ecc076134" hs_bindgen_11c3318ecc076134 :: +hs_bindgen_11c3318ecc076134 :: IO (Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.CInt -> IO FC.CInt)) +hs_bindgen_11c3318ecc076134 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_11c3318ecc076134_base {-# NOINLINE readFileWithProcessor_ptr #-} @@ -195,10 +203,17 @@ readFileWithProcessor_ptr :: Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.C readFileWithProcessor_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_11c3318ecc076134 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_812229d77f36833a" hs_bindgen_812229d77f36833a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.CInt -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_watchTemperature_ptr@ -} -foreign import ccall unsafe "hs_bindgen_812229d77f36833a" hs_bindgen_812229d77f36833a :: +hs_bindgen_812229d77f36833a :: IO (Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.CInt -> IO ())) +hs_bindgen_812229d77f36833a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_812229d77f36833a_base {-# NOINLINE watchTemperature_ptr #-} @@ -212,10 +227,17 @@ watchTemperature_ptr :: Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.CInt - watchTemperature_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_812229d77f36833a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cd162abdd104aa42" hs_bindgen_cd162abdd104aa42_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FileOpenedNotification -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_onFileOpened_ptr@ -} -foreign import ccall unsafe "hs_bindgen_cd162abdd104aa42" hs_bindgen_cd162abdd104aa42 :: +hs_bindgen_cd162abdd104aa42 :: IO (Ptr.FunPtr (FileOpenedNotification -> IO ())) +hs_bindgen_cd162abdd104aa42 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_cd162abdd104aa42_base {-# NOINLINE onFileOpened_ptr #-} @@ -229,10 +251,17 @@ onFileOpened_ptr :: Ptr.FunPtr (FileOpenedNotification -> IO ()) onFileOpened_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_cd162abdd104aa42 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b66e61e98e8145a4" hs_bindgen_b66e61e98e8145a4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (ProgressUpdate -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_onProgressChanged_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b66e61e98e8145a4" hs_bindgen_b66e61e98e8145a4 :: +hs_bindgen_b66e61e98e8145a4 :: IO (Ptr.FunPtr (ProgressUpdate -> IO ())) +hs_bindgen_b66e61e98e8145a4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b66e61e98e8145a4_base {-# NOINLINE onProgressChanged_ptr #-} @@ -246,10 +275,17 @@ onProgressChanged_ptr :: Ptr.FunPtr (ProgressUpdate -> IO ()) onProgressChanged_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_b66e61e98e8145a4 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4c20e93be5c3b5bb" hs_bindgen_4c20e93be5c3b5bb_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (DataValidator -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_functionscallbacks_Example_get_validateInput_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4c20e93be5c3b5bb" hs_bindgen_4c20e93be5c3b5bb :: +hs_bindgen_4c20e93be5c3b5bb :: IO (Ptr.FunPtr (DataValidator -> FC.CInt -> IO FC.CInt)) +hs_bindgen_4c20e93be5c3b5bb = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4c20e93be5c3b5bb_base {-# NOINLINE validateInput_ptr #-} @@ -263,10 +299,17 @@ validateInput_ptr :: Ptr.FunPtr (DataValidator -> FC.CInt -> IO FC.CInt) validateInput_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4c20e93be5c3b5bb +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f0fa88e6072c2d7a" hs_bindgen_f0fa88e6072c2d7a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (MeasurementReceived -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_onNewMeasurement_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f0fa88e6072c2d7a" hs_bindgen_f0fa88e6072c2d7a :: +hs_bindgen_f0fa88e6072c2d7a :: IO (Ptr.FunPtr (MeasurementReceived -> IO ())) +hs_bindgen_f0fa88e6072c2d7a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f0fa88e6072c2d7a_base {-# NOINLINE onNewMeasurement_ptr #-} @@ -280,10 +323,17 @@ onNewMeasurement_ptr :: Ptr.FunPtr (MeasurementReceived -> IO ()) onNewMeasurement_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f0fa88e6072c2d7a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c72d8638d47aae13" hs_bindgen_c72d8638d47aae13_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (MeasurementReceived2 -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_onNewMeasurement2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c72d8638d47aae13" hs_bindgen_c72d8638d47aae13 :: +hs_bindgen_c72d8638d47aae13 :: IO (Ptr.FunPtr (MeasurementReceived2 -> IO ())) +hs_bindgen_c72d8638d47aae13 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c72d8638d47aae13_base {-# NOINLINE onNewMeasurement2_ptr #-} @@ -297,10 +347,17 @@ onNewMeasurement2_ptr :: Ptr.FunPtr (MeasurementReceived2 -> IO ()) onNewMeasurement2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c72d8638d47aae13 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7b54895b95bee198" hs_bindgen_7b54895b95bee198_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (SampleBufferFull -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_onBufferReady_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7b54895b95bee198" hs_bindgen_7b54895b95bee198 :: +hs_bindgen_7b54895b95bee198 :: IO (Ptr.FunPtr (SampleBufferFull -> IO ())) +hs_bindgen_7b54895b95bee198 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7b54895b95bee198_base {-# NOINLINE onBufferReady_ptr #-} @@ -314,10 +371,17 @@ onBufferReady_ptr :: Ptr.FunPtr (SampleBufferFull -> IO ()) onBufferReady_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7b54895b95bee198 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4215bdb12daf9024" hs_bindgen_4215bdb12daf9024_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr (FC.CDouble -> FC.CInt -> IO FC.CDouble)) -> FC.CInt -> IO ())) -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_transformMeasurement_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4215bdb12daf9024" hs_bindgen_4215bdb12daf9024 :: +hs_bindgen_4215bdb12daf9024 :: IO (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr (FC.CDouble -> FC.CInt -> IO FC.CDouble)) -> FC.CInt -> IO ())) -> IO ())) +hs_bindgen_4215bdb12daf9024 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4215bdb12daf9024_base {-# NOINLINE transformMeasurement_ptr #-} @@ -331,10 +395,17 @@ transformMeasurement_ptr :: Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((P transformMeasurement_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4215bdb12daf9024 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_701c0161802d878b" hs_bindgen_701c0161802d878b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr ((Ptr.Ptr Measurement) -> FileOpenedNotification -> FC.CInt -> IO ())) -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_processWithCallbacks_ptr@ -} -foreign import ccall unsafe "hs_bindgen_701c0161802d878b" hs_bindgen_701c0161802d878b :: +hs_bindgen_701c0161802d878b :: IO (Ptr.FunPtr ((Ptr.FunPtr ((Ptr.Ptr Measurement) -> FileOpenedNotification -> FC.CInt -> IO ())) -> IO ())) +hs_bindgen_701c0161802d878b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_701c0161802d878b_base {-# NOINLINE processWithCallbacks_ptr #-} @@ -348,10 +419,17 @@ processWithCallbacks_ptr :: Ptr.FunPtr ((Ptr.FunPtr ((Ptr.Ptr Measurement) -> Fi processWithCallbacks_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_701c0161802d878b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_90c9d96723cea577" hs_bindgen_90c9d96723cea577_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr MeasurementHandler) -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_registerHandler_ptr@ -} -foreign import ccall unsafe "hs_bindgen_90c9d96723cea577" hs_bindgen_90c9d96723cea577 :: +hs_bindgen_90c9d96723cea577 :: IO (Ptr.FunPtr ((Ptr.Ptr MeasurementHandler) -> IO ())) +hs_bindgen_90c9d96723cea577 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_90c9d96723cea577_base {-# NOINLINE registerHandler_ptr #-} @@ -365,10 +443,17 @@ registerHandler_ptr :: Ptr.FunPtr ((Ptr.Ptr MeasurementHandler) -> IO ()) registerHandler_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_90c9d96723cea577 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bc33471040d45469" hs_bindgen_bc33471040d45469_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.Ptr DataPipeline) -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_executePipeline_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bc33471040d45469" hs_bindgen_bc33471040d45469 :: +hs_bindgen_bc33471040d45469 :: IO (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.Ptr DataPipeline) -> IO ())) +hs_bindgen_bc33471040d45469 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bc33471040d45469_base {-# NOINLINE executePipeline_ptr #-} @@ -382,10 +467,17 @@ executePipeline_ptr :: Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.Ptr DataPipelin executePipeline_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bc33471040d45469 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_86a8e8897172172b" hs_bindgen_86a8e8897172172b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.Ptr Processor) -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_runProcessor_ptr@ -} -foreign import ccall unsafe "hs_bindgen_86a8e8897172172b" hs_bindgen_86a8e8897172172b :: +hs_bindgen_86a8e8897172172b :: IO (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.Ptr Processor) -> IO ())) +hs_bindgen_86a8e8897172172b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_86a8e8897172172b_base {-# NOINLINE runProcessor_ptr #-} @@ -399,10 +491,17 @@ runProcessor_ptr :: Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.Ptr Processor) -> runProcessor_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_86a8e8897172172b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f4667aed4d51fd75" hs_bindgen_f4667aed4d51fd75_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> DataValidator -> FC.CInt -> IO ())) -> DataValidator -> IO ())) -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_processMeasurementWithValidation_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f4667aed4d51fd75" hs_bindgen_f4667aed4d51fd75 :: +hs_bindgen_f4667aed4d51fd75 :: IO (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> DataValidator -> FC.CInt -> IO ())) -> DataValidator -> IO ())) -> IO ())) +hs_bindgen_f4667aed4d51fd75 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f4667aed4d51fd75_base {-# NOINLINE processMeasurementWithValidation_ptr #-} @@ -416,10 +515,17 @@ processMeasurementWithValidation_ptr :: Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Pt processMeasurementWithValidation_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f4667aed4d51fd75 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_77b468218b567b37" hs_bindgen_77b468218b567b37_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr (Foo -> IO ())) -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_f_ptr@ -} -foreign import ccall unsafe "hs_bindgen_77b468218b567b37" hs_bindgen_77b468218b567b37 :: +hs_bindgen_77b468218b567b37 :: IO (Ptr.FunPtr ((Ptr.FunPtr (Foo -> IO ())) -> IO ())) +hs_bindgen_77b468218b567b37 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_77b468218b567b37_base {-# NOINLINE f_ptr #-} @@ -433,10 +539,17 @@ f_ptr :: Ptr.FunPtr ((Ptr.FunPtr (Foo -> IO ())) -> IO ()) f_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_77b468218b567b37 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d5a4de10d670d97d" hs_bindgen_d5a4de10d670d97d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr (Foo2 -> IO ())) -> IO ()))) + {-| __unique:__ @test_functionscallbacks_Example_get_f2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d5a4de10d670d97d" hs_bindgen_d5a4de10d670d97d :: +hs_bindgen_d5a4de10d670d97d :: IO (Ptr.FunPtr ((Ptr.FunPtr (Foo2 -> IO ())) -> IO ())) +hs_bindgen_d5a4de10d670d97d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d5a4de10d670d97d_base {-# NOINLINE f2_ptr #-} diff --git a/hs-bindgen/fixtures/functions/callbacks/Example/Safe.hs b/hs-bindgen/fixtures/functions/callbacks/Example/Safe.hs index 466c34a7c..4c43a1933 100644 --- a/hs-bindgen/fixtures/functions/callbacks/Example/Safe.hs +++ b/hs-bindgen/fixtures/functions/callbacks/Example/Safe.hs @@ -7,6 +7,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -145,6 +146,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_99bda9cd8097b0ea" readFileWithProcessor_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.CInt -> IO FC.CInt) + {-| __C declaration:__ @readFileWithProcessor@ __defined at:__ @functions\/callbacks.h:4:5@ @@ -153,7 +159,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_functionscallbacks_Example_Safe_readFileWithProcessor@ -} -foreign import ccall safe "hs_bindgen_99bda9cd8097b0ea" readFileWithProcessor :: +readFileWithProcessor :: Ptr.FunPtr (FC.CInt -> IO ()) {- ^ __C declaration:__ @processLine@ -} @@ -161,6 +167,13 @@ foreign import ccall safe "hs_bindgen_99bda9cd8097b0ea" readFileWithProcessor :: {- ^ __C declaration:__ @fileId@ -} -> IO FC.CInt +readFileWithProcessor = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType readFileWithProcessor_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_84b75366c836fc85" watchTemperature_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.CInt -> IO ()) {-| __C declaration:__ @watchTemperature@ @@ -170,7 +183,7 @@ foreign import ccall safe "hs_bindgen_99bda9cd8097b0ea" readFileWithProcessor :: __unique:__ @test_functionscallbacks_Example_Safe_watchTemperature@ -} -foreign import ccall safe "hs_bindgen_84b75366c836fc85" watchTemperature :: +watchTemperature :: Ptr.FunPtr (FC.CInt -> IO ()) {- ^ __C declaration:__ @onTempChange@ -} @@ -178,6 +191,13 @@ foreign import ccall safe "hs_bindgen_84b75366c836fc85" watchTemperature :: {- ^ __C declaration:__ @sensorId@ -} -> IO () +watchTemperature = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType watchTemperature_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f2580f574faa3697" onFileOpened_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FileOpenedNotification -> IO ()) {-| __C declaration:__ @onFileOpened@ @@ -187,11 +207,18 @@ foreign import ccall safe "hs_bindgen_84b75366c836fc85" watchTemperature :: __unique:__ @test_functionscallbacks_Example_Safe_onFileOpened@ -} -foreign import ccall safe "hs_bindgen_f2580f574faa3697" onFileOpened :: +onFileOpened :: FileOpenedNotification {- ^ __C declaration:__ @notify@ -} -> IO () +onFileOpened = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onFileOpened_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_654057b291ee37ea" onProgressChanged_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (ProgressUpdate -> IO ()) {-| __C declaration:__ @onProgressChanged@ @@ -201,11 +228,18 @@ foreign import ccall safe "hs_bindgen_f2580f574faa3697" onFileOpened :: __unique:__ @test_functionscallbacks_Example_Safe_onProgressChanged@ -} -foreign import ccall safe "hs_bindgen_654057b291ee37ea" onProgressChanged :: +onProgressChanged :: ProgressUpdate {- ^ __C declaration:__ @update@ -} -> IO () +onProgressChanged = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onProgressChanged_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5df7aac6996be10f" validateInput_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (DataValidator -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @validateInput@ @@ -215,7 +249,7 @@ foreign import ccall safe "hs_bindgen_654057b291ee37ea" onProgressChanged :: __unique:__ @test_functionscallbacks_Example_Safe_validateInput@ -} -foreign import ccall safe "hs_bindgen_5df7aac6996be10f" validateInput :: +validateInput :: DataValidator {- ^ __C declaration:__ @validator@ -} @@ -223,6 +257,13 @@ foreign import ccall safe "hs_bindgen_5df7aac6996be10f" validateInput :: {- ^ __C declaration:__ @rawValue@ -} -> IO FC.CInt +validateInput = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType validateInput_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8f1bb1c4d2b5355f" onNewMeasurement_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (MeasurementReceived -> IO ()) {-| __C declaration:__ @onNewMeasurement@ @@ -232,11 +273,18 @@ foreign import ccall safe "hs_bindgen_5df7aac6996be10f" validateInput :: __unique:__ @test_functionscallbacks_Example_Safe_onNewMeasurement@ -} -foreign import ccall safe "hs_bindgen_8f1bb1c4d2b5355f" onNewMeasurement :: +onNewMeasurement :: MeasurementReceived {- ^ __C declaration:__ @handler@ -} -> IO () +onNewMeasurement = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onNewMeasurement_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d805e39c6cbdd620" onNewMeasurement2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (MeasurementReceived2 -> IO ()) {-| __C declaration:__ @onNewMeasurement2@ @@ -246,11 +294,18 @@ foreign import ccall safe "hs_bindgen_8f1bb1c4d2b5355f" onNewMeasurement :: __unique:__ @test_functionscallbacks_Example_Safe_onNewMeasurement2@ -} -foreign import ccall safe "hs_bindgen_d805e39c6cbdd620" onNewMeasurement2 :: +onNewMeasurement2 :: MeasurementReceived2 {- ^ __C declaration:__ @handler@ -} -> IO () +onNewMeasurement2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onNewMeasurement2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8d803591bcf10ba5" onBufferReady_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (SampleBufferFull -> IO ()) {-| __C declaration:__ @onBufferReady@ @@ -260,11 +315,18 @@ foreign import ccall safe "hs_bindgen_d805e39c6cbdd620" onNewMeasurement2 :: __unique:__ @test_functionscallbacks_Example_Safe_onBufferReady@ -} -foreign import ccall safe "hs_bindgen_8d803591bcf10ba5" onBufferReady :: +onBufferReady :: SampleBufferFull {- ^ __C declaration:__ @handler@ -} -> IO () +onBufferReady = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onBufferReady_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_16c298a15b737eb2" transformMeasurement_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr (FC.CDouble -> FC.CInt -> IO FC.CDouble)) -> FC.CInt -> IO ())) -> IO ()) {-| __C declaration:__ @transformMeasurement@ @@ -274,7 +336,7 @@ foreign import ccall safe "hs_bindgen_8d803591bcf10ba5" onBufferReady :: __unique:__ @test_functionscallbacks_Example_Safe_transformMeasurement@ -} -foreign import ccall safe "hs_bindgen_16c298a15b737eb2" transformMeasurement :: +transformMeasurement :: Ptr.Ptr Measurement {- ^ __C declaration:__ @data'@ -} @@ -282,6 +344,13 @@ foreign import ccall safe "hs_bindgen_16c298a15b737eb2" transformMeasurement :: {- ^ __C declaration:__ @transformer@ -} -> IO () +transformMeasurement = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType transformMeasurement_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e6a073138e56764f" processWithCallbacks_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr ((Ptr.Ptr Measurement) -> FileOpenedNotification -> FC.CInt -> IO ())) -> IO ()) {-| __C declaration:__ @processWithCallbacks@ @@ -291,11 +360,18 @@ foreign import ccall safe "hs_bindgen_16c298a15b737eb2" transformMeasurement :: __unique:__ @test_functionscallbacks_Example_Safe_processWithCallbacks@ -} -foreign import ccall safe "hs_bindgen_e6a073138e56764f" processWithCallbacks :: +processWithCallbacks :: Ptr.FunPtr ((Ptr.Ptr Measurement) -> FileOpenedNotification -> FC.CInt -> IO ()) {- ^ __C declaration:__ @handler@ -} -> IO () +processWithCallbacks = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType processWithCallbacks_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ece0d4f94c2319f0" registerHandler_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr MeasurementHandler) -> IO ()) {-| __C declaration:__ @registerHandler@ @@ -305,11 +381,18 @@ foreign import ccall safe "hs_bindgen_e6a073138e56764f" processWithCallbacks :: __unique:__ @test_functionscallbacks_Example_Safe_registerHandler@ -} -foreign import ccall safe "hs_bindgen_ece0d4f94c2319f0" registerHandler :: +registerHandler :: Ptr.Ptr MeasurementHandler {- ^ __C declaration:__ @handler@ -} -> IO () +registerHandler = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType registerHandler_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d66d7470a7a213b0" executePipeline_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Measurement) -> (Ptr.Ptr DataPipeline) -> IO ()) {-| __C declaration:__ @executePipeline@ @@ -319,7 +402,7 @@ foreign import ccall safe "hs_bindgen_ece0d4f94c2319f0" registerHandler :: __unique:__ @test_functionscallbacks_Example_Safe_executePipeline@ -} -foreign import ccall safe "hs_bindgen_d66d7470a7a213b0" executePipeline :: +executePipeline :: Ptr.Ptr Measurement {- ^ __C declaration:__ @data'@ -} @@ -327,6 +410,13 @@ foreign import ccall safe "hs_bindgen_d66d7470a7a213b0" executePipeline :: {- ^ __C declaration:__ @pipeline@ -} -> IO () +executePipeline = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType executePipeline_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e925d3ce6e5fb395" runProcessor_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Measurement) -> (Ptr.Ptr Processor) -> IO ()) {-| __C declaration:__ @runProcessor@ @@ -336,7 +426,7 @@ foreign import ccall safe "hs_bindgen_d66d7470a7a213b0" executePipeline :: __unique:__ @test_functionscallbacks_Example_Safe_runProcessor@ -} -foreign import ccall safe "hs_bindgen_e925d3ce6e5fb395" runProcessor :: +runProcessor :: Ptr.Ptr Measurement {- ^ __C declaration:__ @data'@ -} @@ -344,6 +434,13 @@ foreign import ccall safe "hs_bindgen_e925d3ce6e5fb395" runProcessor :: {- ^ __C declaration:__ @processor@ -} -> IO () +runProcessor = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType runProcessor_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1e432e1595a1ef55" processMeasurementWithValidation_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> DataValidator -> FC.CInt -> IO ())) -> DataValidator -> IO ())) -> IO ()) {-| __C declaration:__ @processMeasurementWithValidation@ @@ -353,7 +450,7 @@ foreign import ccall safe "hs_bindgen_e925d3ce6e5fb395" runProcessor :: __unique:__ @test_functionscallbacks_Example_Safe_processMeasurementWithValidation@ -} -foreign import ccall safe "hs_bindgen_1e432e1595a1ef55" processMeasurementWithValidation :: +processMeasurementWithValidation :: Ptr.Ptr Measurement {- ^ __C declaration:__ @data'@ -} @@ -361,6 +458,13 @@ foreign import ccall safe "hs_bindgen_1e432e1595a1ef55" processMeasurementWithVa {- ^ __C declaration:__ @processor@ -} -> IO () +processMeasurementWithValidation = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType processMeasurementWithValidation_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d5cd030edf2e0364" f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (Foo -> IO ())) -> IO ()) {-| __C declaration:__ @f@ @@ -370,11 +474,18 @@ foreign import ccall safe "hs_bindgen_1e432e1595a1ef55" processMeasurementWithVa __unique:__ @test_functionscallbacks_Example_Safe_f@ -} -foreign import ccall safe "hs_bindgen_d5cd030edf2e0364" f :: +f :: Ptr.FunPtr (Foo -> IO ()) {- ^ __C declaration:__ @callback@ -} -> IO () +f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a10eec74074627ba" f2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (Foo2 -> IO ())) -> IO ()) {-| __C declaration:__ @f2@ @@ -384,8 +495,10 @@ foreign import ccall safe "hs_bindgen_d5cd030edf2e0364" f :: __unique:__ @test_functionscallbacks_Example_Safe_f2@ -} -foreign import ccall safe "hs_bindgen_a10eec74074627ba" f2 :: +f2 :: Ptr.FunPtr (Foo2 -> IO ()) {- ^ __C declaration:__ @handler@ -} -> IO () +f2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f2_base diff --git a/hs-bindgen/fixtures/functions/callbacks/Example/Unsafe.hs b/hs-bindgen/fixtures/functions/callbacks/Example/Unsafe.hs index 77c5628d3..9555abb13 100644 --- a/hs-bindgen/fixtures/functions/callbacks/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/functions/callbacks/Example/Unsafe.hs @@ -7,6 +7,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -145,6 +146,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d07f3a3e526e7017" readFileWithProcessor_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.CInt -> IO FC.CInt) + {-| __C declaration:__ @readFileWithProcessor@ __defined at:__ @functions\/callbacks.h:4:5@ @@ -153,7 +159,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_functionscallbacks_Example_Unsafe_readFileWithProcessor@ -} -foreign import ccall unsafe "hs_bindgen_d07f3a3e526e7017" readFileWithProcessor :: +readFileWithProcessor :: Ptr.FunPtr (FC.CInt -> IO ()) {- ^ __C declaration:__ @processLine@ -} @@ -161,6 +167,13 @@ foreign import ccall unsafe "hs_bindgen_d07f3a3e526e7017" readFileWithProcessor {- ^ __C declaration:__ @fileId@ -} -> IO FC.CInt +readFileWithProcessor = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType readFileWithProcessor_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cb0219aedd5afed5" watchTemperature_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (FC.CInt -> IO ())) -> FC.CInt -> IO ()) {-| __C declaration:__ @watchTemperature@ @@ -170,7 +183,7 @@ foreign import ccall unsafe "hs_bindgen_d07f3a3e526e7017" readFileWithProcessor __unique:__ @test_functionscallbacks_Example_Unsafe_watchTemperature@ -} -foreign import ccall unsafe "hs_bindgen_cb0219aedd5afed5" watchTemperature :: +watchTemperature :: Ptr.FunPtr (FC.CInt -> IO ()) {- ^ __C declaration:__ @onTempChange@ -} @@ -178,6 +191,13 @@ foreign import ccall unsafe "hs_bindgen_cb0219aedd5afed5" watchTemperature :: {- ^ __C declaration:__ @sensorId@ -} -> IO () +watchTemperature = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType watchTemperature_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d96938841a039f9b" onFileOpened_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FileOpenedNotification -> IO ()) {-| __C declaration:__ @onFileOpened@ @@ -187,11 +207,18 @@ foreign import ccall unsafe "hs_bindgen_cb0219aedd5afed5" watchTemperature :: __unique:__ @test_functionscallbacks_Example_Unsafe_onFileOpened@ -} -foreign import ccall unsafe "hs_bindgen_d96938841a039f9b" onFileOpened :: +onFileOpened :: FileOpenedNotification {- ^ __C declaration:__ @notify@ -} -> IO () +onFileOpened = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onFileOpened_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3cb24888fc3e1751" onProgressChanged_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (ProgressUpdate -> IO ()) {-| __C declaration:__ @onProgressChanged@ @@ -201,11 +228,18 @@ foreign import ccall unsafe "hs_bindgen_d96938841a039f9b" onFileOpened :: __unique:__ @test_functionscallbacks_Example_Unsafe_onProgressChanged@ -} -foreign import ccall unsafe "hs_bindgen_3cb24888fc3e1751" onProgressChanged :: +onProgressChanged :: ProgressUpdate {- ^ __C declaration:__ @update@ -} -> IO () +onProgressChanged = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onProgressChanged_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_567ea6dc040b50a1" validateInput_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (DataValidator -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @validateInput@ @@ -215,7 +249,7 @@ foreign import ccall unsafe "hs_bindgen_3cb24888fc3e1751" onProgressChanged :: __unique:__ @test_functionscallbacks_Example_Unsafe_validateInput@ -} -foreign import ccall unsafe "hs_bindgen_567ea6dc040b50a1" validateInput :: +validateInput :: DataValidator {- ^ __C declaration:__ @validator@ -} @@ -223,6 +257,13 @@ foreign import ccall unsafe "hs_bindgen_567ea6dc040b50a1" validateInput :: {- ^ __C declaration:__ @rawValue@ -} -> IO FC.CInt +validateInput = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType validateInput_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_aab80c08edfa6b4b" onNewMeasurement_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (MeasurementReceived -> IO ()) {-| __C declaration:__ @onNewMeasurement@ @@ -232,11 +273,18 @@ foreign import ccall unsafe "hs_bindgen_567ea6dc040b50a1" validateInput :: __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement@ -} -foreign import ccall unsafe "hs_bindgen_aab80c08edfa6b4b" onNewMeasurement :: +onNewMeasurement :: MeasurementReceived {- ^ __C declaration:__ @handler@ -} -> IO () +onNewMeasurement = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onNewMeasurement_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6c8fae51df7c46a1" onNewMeasurement2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (MeasurementReceived2 -> IO ()) {-| __C declaration:__ @onNewMeasurement2@ @@ -246,11 +294,18 @@ foreign import ccall unsafe "hs_bindgen_aab80c08edfa6b4b" onNewMeasurement :: __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement2@ -} -foreign import ccall unsafe "hs_bindgen_6c8fae51df7c46a1" onNewMeasurement2 :: +onNewMeasurement2 :: MeasurementReceived2 {- ^ __C declaration:__ @handler@ -} -> IO () +onNewMeasurement2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onNewMeasurement2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d44afeb36d2ae523" onBufferReady_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (SampleBufferFull -> IO ()) {-| __C declaration:__ @onBufferReady@ @@ -260,11 +315,18 @@ foreign import ccall unsafe "hs_bindgen_6c8fae51df7c46a1" onNewMeasurement2 :: __unique:__ @test_functionscallbacks_Example_Unsafe_onBufferReady@ -} -foreign import ccall unsafe "hs_bindgen_d44afeb36d2ae523" onBufferReady :: +onBufferReady :: SampleBufferFull {- ^ __C declaration:__ @handler@ -} -> IO () +onBufferReady = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType onBufferReady_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_523fee13fb646cad" transformMeasurement_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr (FC.CDouble -> FC.CInt -> IO FC.CDouble)) -> FC.CInt -> IO ())) -> IO ()) {-| __C declaration:__ @transformMeasurement@ @@ -274,7 +336,7 @@ foreign import ccall unsafe "hs_bindgen_d44afeb36d2ae523" onBufferReady :: __unique:__ @test_functionscallbacks_Example_Unsafe_transformMeasurement@ -} -foreign import ccall unsafe "hs_bindgen_523fee13fb646cad" transformMeasurement :: +transformMeasurement :: Ptr.Ptr Measurement {- ^ __C declaration:__ @data'@ -} @@ -282,6 +344,13 @@ foreign import ccall unsafe "hs_bindgen_523fee13fb646cad" transformMeasurement : {- ^ __C declaration:__ @transformer@ -} -> IO () +transformMeasurement = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType transformMeasurement_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_98d0c5bd1271eeb7" processWithCallbacks_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr ((Ptr.Ptr Measurement) -> FileOpenedNotification -> FC.CInt -> IO ())) -> IO ()) {-| __C declaration:__ @processWithCallbacks@ @@ -291,11 +360,18 @@ foreign import ccall unsafe "hs_bindgen_523fee13fb646cad" transformMeasurement : __unique:__ @test_functionscallbacks_Example_Unsafe_processWithCallbacks@ -} -foreign import ccall unsafe "hs_bindgen_98d0c5bd1271eeb7" processWithCallbacks :: +processWithCallbacks :: Ptr.FunPtr ((Ptr.Ptr Measurement) -> FileOpenedNotification -> FC.CInt -> IO ()) {- ^ __C declaration:__ @handler@ -} -> IO () +processWithCallbacks = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType processWithCallbacks_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b96f4d4d7893e301" registerHandler_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr MeasurementHandler) -> IO ()) {-| __C declaration:__ @registerHandler@ @@ -305,11 +381,18 @@ foreign import ccall unsafe "hs_bindgen_98d0c5bd1271eeb7" processWithCallbacks : __unique:__ @test_functionscallbacks_Example_Unsafe_registerHandler@ -} -foreign import ccall unsafe "hs_bindgen_b96f4d4d7893e301" registerHandler :: +registerHandler :: Ptr.Ptr MeasurementHandler {- ^ __C declaration:__ @handler@ -} -> IO () +registerHandler = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType registerHandler_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c062ded603732aae" executePipeline_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Measurement) -> (Ptr.Ptr DataPipeline) -> IO ()) {-| __C declaration:__ @executePipeline@ @@ -319,7 +402,7 @@ foreign import ccall unsafe "hs_bindgen_b96f4d4d7893e301" registerHandler :: __unique:__ @test_functionscallbacks_Example_Unsafe_executePipeline@ -} -foreign import ccall unsafe "hs_bindgen_c062ded603732aae" executePipeline :: +executePipeline :: Ptr.Ptr Measurement {- ^ __C declaration:__ @data'@ -} @@ -327,6 +410,13 @@ foreign import ccall unsafe "hs_bindgen_c062ded603732aae" executePipeline :: {- ^ __C declaration:__ @pipeline@ -} -> IO () +executePipeline = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType executePipeline_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_02d41a1f48eebff7" runProcessor_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Measurement) -> (Ptr.Ptr Processor) -> IO ()) {-| __C declaration:__ @runProcessor@ @@ -336,7 +426,7 @@ foreign import ccall unsafe "hs_bindgen_c062ded603732aae" executePipeline :: __unique:__ @test_functionscallbacks_Example_Unsafe_runProcessor@ -} -foreign import ccall unsafe "hs_bindgen_02d41a1f48eebff7" runProcessor :: +runProcessor :: Ptr.Ptr Measurement {- ^ __C declaration:__ @data'@ -} @@ -344,6 +434,13 @@ foreign import ccall unsafe "hs_bindgen_02d41a1f48eebff7" runProcessor :: {- ^ __C declaration:__ @processor@ -} -> IO () +runProcessor = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType runProcessor_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_39704c8b14c2ce3c" processMeasurementWithValidation_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> (Ptr.FunPtr ((Ptr.Ptr Measurement) -> DataValidator -> FC.CInt -> IO ())) -> DataValidator -> IO ())) -> IO ()) {-| __C declaration:__ @processMeasurementWithValidation@ @@ -353,7 +450,7 @@ foreign import ccall unsafe "hs_bindgen_02d41a1f48eebff7" runProcessor :: __unique:__ @test_functionscallbacks_Example_Unsafe_processMeasurementWithValidation@ -} -foreign import ccall unsafe "hs_bindgen_39704c8b14c2ce3c" processMeasurementWithValidation :: +processMeasurementWithValidation :: Ptr.Ptr Measurement {- ^ __C declaration:__ @data'@ -} @@ -361,6 +458,13 @@ foreign import ccall unsafe "hs_bindgen_39704c8b14c2ce3c" processMeasurementWith {- ^ __C declaration:__ @processor@ -} -> IO () +processMeasurementWithValidation = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType processMeasurementWithValidation_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_10c383cdf6eddb0d" f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (Foo -> IO ())) -> IO ()) {-| __C declaration:__ @f@ @@ -370,11 +474,18 @@ foreign import ccall unsafe "hs_bindgen_39704c8b14c2ce3c" processMeasurementWith __unique:__ @test_functionscallbacks_Example_Unsafe_f@ -} -foreign import ccall unsafe "hs_bindgen_10c383cdf6eddb0d" f :: +f :: Ptr.FunPtr (Foo -> IO ()) {- ^ __C declaration:__ @callback@ -} -> IO () +f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_831d03bed0065a4e" f2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (Foo2 -> IO ())) -> IO ()) {-| __C declaration:__ @f2@ @@ -384,8 +495,10 @@ foreign import ccall unsafe "hs_bindgen_10c383cdf6eddb0d" f :: __unique:__ @test_functionscallbacks_Example_Unsafe_f2@ -} -foreign import ccall unsafe "hs_bindgen_831d03bed0065a4e" f2 :: +f2 :: Ptr.FunPtr (Foo2 -> IO ()) {- ^ __C declaration:__ @handler@ -} -> IO () +f2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f2_base diff --git a/hs-bindgen/fixtures/functions/callbacks/th.txt b/hs-bindgen/fixtures/functions/callbacks/th.txt index 3b72075cc..cc36b3aa4 100644 --- a/hs-bindgen/fixtures/functions/callbacks/th.txt +++ b/hs-bindgen/fixtures/functions/callbacks/th.txt @@ -1511,6 +1511,12 @@ instance ToFunPtr (Foo2 -> IO Unit) where toFunPtr = hs_bindgen_235fa4a89af25f04 instance FromFunPtr (Foo2 -> IO Unit) where fromFunPtr = hs_bindgen_8605b223a9ab9562 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_99bda9cd8097b0ea" readFileWithProcessor_base :: BaseForeignType (FunPtr (CInt -> + IO Unit) -> + CInt -> + IO CInt) {-| __C declaration:__ @readFileWithProcessor@ __defined at:__ @functions\/callbacks.h:4:5@ @@ -1519,9 +1525,23 @@ instance FromFunPtr (Foo2 -> IO Unit) __unique:__ @test_functionscallbacks_Example_Unsafe_readFileWithProcessor@ -} -foreign import ccall safe "hs_bindgen_99bda9cd8097b0ea" readFileWithProcessor :: FunPtr (CInt -> - IO Unit) -> - CInt -> IO CInt +readFileWithProcessor :: FunPtr (CInt -> IO Unit) -> + CInt -> IO CInt +{-| __C declaration:__ @readFileWithProcessor@ + + __defined at:__ @functions\/callbacks.h:4:5@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_readFileWithProcessor@ +-} +readFileWithProcessor = fromBaseForeignType readFileWithProcessor_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_84b75366c836fc85" watchTemperature_base :: BaseForeignType (FunPtr (CInt -> + IO Unit) -> + CInt -> + IO Unit) {-| __C declaration:__ @watchTemperature@ __defined at:__ @functions\/callbacks.h:5:6@ @@ -1530,9 +1550,29 @@ foreign import ccall safe "hs_bindgen_99bda9cd8097b0ea" readFileWithProcessor :: __unique:__ @test_functionscallbacks_Example_Unsafe_watchTemperature@ -} -foreign import ccall safe "hs_bindgen_84b75366c836fc85" watchTemperature :: FunPtr (CInt -> - IO Unit) -> - CInt -> IO Unit +watchTemperature :: FunPtr (CInt -> IO Unit) -> CInt -> IO Unit +{-| __C declaration:__ @watchTemperature@ + + __defined at:__ @functions\/callbacks.h:5:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_watchTemperature@ +-} +watchTemperature = fromBaseForeignType watchTemperature_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f2580f574faa3697" onFileOpened_base :: BaseForeignType (FileOpenedNotification -> + IO Unit) +{-| __C declaration:__ @onFileOpened@ + + __defined at:__ @functions\/callbacks.h:14:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onFileOpened@ +-} +onFileOpened :: FileOpenedNotification -> IO Unit {-| __C declaration:__ @onFileOpened@ __defined at:__ @functions\/callbacks.h:14:6@ @@ -1541,8 +1581,11 @@ foreign import ccall safe "hs_bindgen_84b75366c836fc85" watchTemperature :: FunP __unique:__ @test_functionscallbacks_Example_Unsafe_onFileOpened@ -} -foreign import ccall safe "hs_bindgen_f2580f574faa3697" onFileOpened :: FileOpenedNotification -> - IO Unit +onFileOpened = fromBaseForeignType onFileOpened_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_654057b291ee37ea" onProgressChanged_base :: BaseForeignType (ProgressUpdate -> + IO Unit) {-| __C declaration:__ @onProgressChanged@ __defined at:__ @functions\/callbacks.h:15:6@ @@ -1551,8 +1594,21 @@ foreign import ccall safe "hs_bindgen_f2580f574faa3697" onFileOpened :: FileOpen __unique:__ @test_functionscallbacks_Example_Unsafe_onProgressChanged@ -} -foreign import ccall safe "hs_bindgen_654057b291ee37ea" onProgressChanged :: ProgressUpdate -> - IO Unit +onProgressChanged :: ProgressUpdate -> IO Unit +{-| __C declaration:__ @onProgressChanged@ + + __defined at:__ @functions\/callbacks.h:15:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onProgressChanged@ +-} +onProgressChanged = fromBaseForeignType onProgressChanged_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5df7aac6996be10f" validateInput_base :: BaseForeignType (DataValidator -> + CInt -> + IO CInt) {-| __C declaration:__ @validateInput@ __defined at:__ @functions\/callbacks.h:16:5@ @@ -1561,8 +1617,20 @@ foreign import ccall safe "hs_bindgen_654057b291ee37ea" onProgressChanged :: Pro __unique:__ @test_functionscallbacks_Example_Unsafe_validateInput@ -} -foreign import ccall safe "hs_bindgen_5df7aac6996be10f" validateInput :: DataValidator -> - CInt -> IO CInt +validateInput :: DataValidator -> CInt -> IO CInt +{-| __C declaration:__ @validateInput@ + + __defined at:__ @functions\/callbacks.h:16:5@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_validateInput@ +-} +validateInput = fromBaseForeignType validateInput_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8f1bb1c4d2b5355f" onNewMeasurement_base :: BaseForeignType (MeasurementReceived -> + IO Unit) {-| __C declaration:__ @onNewMeasurement@ __defined at:__ @functions\/callbacks.h:27:6@ @@ -1571,8 +1639,29 @@ foreign import ccall safe "hs_bindgen_5df7aac6996be10f" validateInput :: DataVal __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement@ -} -foreign import ccall safe "hs_bindgen_8f1bb1c4d2b5355f" onNewMeasurement :: MeasurementReceived -> - IO Unit +onNewMeasurement :: MeasurementReceived -> IO Unit +{-| __C declaration:__ @onNewMeasurement@ + + __defined at:__ @functions\/callbacks.h:27:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement@ +-} +onNewMeasurement = fromBaseForeignType onNewMeasurement_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d805e39c6cbdd620" onNewMeasurement2_base :: BaseForeignType (MeasurementReceived2 -> + IO Unit) +{-| __C declaration:__ @onNewMeasurement2@ + + __defined at:__ @functions\/callbacks.h:30:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement2@ +-} +onNewMeasurement2 :: MeasurementReceived2 -> IO Unit {-| __C declaration:__ @onNewMeasurement2@ __defined at:__ @functions\/callbacks.h:30:6@ @@ -1581,8 +1670,20 @@ foreign import ccall safe "hs_bindgen_8f1bb1c4d2b5355f" onNewMeasurement :: Meas __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement2@ -} -foreign import ccall safe "hs_bindgen_d805e39c6cbdd620" onNewMeasurement2 :: MeasurementReceived2 -> - IO Unit +onNewMeasurement2 = fromBaseForeignType onNewMeasurement2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8d803591bcf10ba5" onBufferReady_base :: BaseForeignType (SampleBufferFull -> + IO Unit) +{-| __C declaration:__ @onBufferReady@ + + __defined at:__ @functions\/callbacks.h:33:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onBufferReady@ +-} +onBufferReady :: SampleBufferFull -> IO Unit {-| __C declaration:__ @onBufferReady@ __defined at:__ @functions\/callbacks.h:33:6@ @@ -1591,8 +1692,29 @@ foreign import ccall safe "hs_bindgen_d805e39c6cbdd620" onNewMeasurement2 :: Mea __unique:__ @test_functionscallbacks_Example_Unsafe_onBufferReady@ -} -foreign import ccall safe "hs_bindgen_8d803591bcf10ba5" onBufferReady :: SampleBufferFull -> - IO Unit +onBufferReady = fromBaseForeignType onBufferReady_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_16c298a15b737eb2" transformMeasurement_base :: BaseForeignType (Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (CDouble -> + CInt -> + IO CDouble) -> + CInt -> + IO Unit) -> + IO Unit) +{-| __C declaration:__ @transformMeasurement@ + + __defined at:__ @functions\/callbacks.h:38:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_transformMeasurement@ +-} +transformMeasurement :: Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (CDouble -> CInt -> IO CDouble) -> CInt -> IO Unit) -> + IO Unit {-| __C declaration:__ @transformMeasurement@ __defined at:__ @functions\/callbacks.h:38:6@ @@ -1601,14 +1723,25 @@ foreign import ccall safe "hs_bindgen_8d803591bcf10ba5" onBufferReady :: SampleB __unique:__ @test_functionscallbacks_Example_Unsafe_transformMeasurement@ -} -foreign import ccall safe "hs_bindgen_16c298a15b737eb2" transformMeasurement :: Ptr Measurement -> - FunPtr (Ptr Measurement -> - FunPtr (CDouble -> - CInt -> - IO CDouble) -> - CInt -> - IO Unit) -> - IO Unit +transformMeasurement = fromBaseForeignType transformMeasurement_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e6a073138e56764f" processWithCallbacks_base :: BaseForeignType (FunPtr (Ptr Measurement -> + FileOpenedNotification -> + CInt -> + IO Unit) -> + IO Unit) +{-| __C declaration:__ @processWithCallbacks@ + + __defined at:__ @functions\/callbacks.h:43:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_processWithCallbacks@ +-} +processWithCallbacks :: FunPtr (Ptr Measurement -> + FileOpenedNotification -> CInt -> IO Unit) -> + IO Unit {-| __C declaration:__ @processWithCallbacks@ __defined at:__ @functions\/callbacks.h:43:6@ @@ -1617,11 +1750,11 @@ foreign import ccall safe "hs_bindgen_16c298a15b737eb2" transformMeasurement :: __unique:__ @test_functionscallbacks_Example_Unsafe_processWithCallbacks@ -} -foreign import ccall safe "hs_bindgen_e6a073138e56764f" processWithCallbacks :: FunPtr (Ptr Measurement -> - FileOpenedNotification -> - CInt -> - IO Unit) -> - IO Unit +processWithCallbacks = fromBaseForeignType processWithCallbacks_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ece0d4f94c2319f0" registerHandler_base :: BaseForeignType (Ptr MeasurementHandler -> + IO Unit) {-| __C declaration:__ @registerHandler@ __defined at:__ @functions\/callbacks.h:56:6@ @@ -1630,8 +1763,30 @@ foreign import ccall safe "hs_bindgen_e6a073138e56764f" processWithCallbacks :: __unique:__ @test_functionscallbacks_Example_Unsafe_registerHandler@ -} -foreign import ccall safe "hs_bindgen_ece0d4f94c2319f0" registerHandler :: Ptr MeasurementHandler -> - IO Unit +registerHandler :: Ptr MeasurementHandler -> IO Unit +{-| __C declaration:__ @registerHandler@ + + __defined at:__ @functions\/callbacks.h:56:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_registerHandler@ +-} +registerHandler = fromBaseForeignType registerHandler_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d66d7470a7a213b0" executePipeline_base :: BaseForeignType (Ptr Measurement -> + Ptr DataPipeline -> + IO Unit) +{-| __C declaration:__ @executePipeline@ + + __defined at:__ @functions\/callbacks.h:64:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_executePipeline@ +-} +executePipeline :: Ptr Measurement -> Ptr DataPipeline -> IO Unit {-| __C declaration:__ @executePipeline@ __defined at:__ @functions\/callbacks.h:64:6@ @@ -1640,9 +1795,12 @@ foreign import ccall safe "hs_bindgen_ece0d4f94c2319f0" registerHandler :: Ptr M __unique:__ @test_functionscallbacks_Example_Unsafe_executePipeline@ -} -foreign import ccall safe "hs_bindgen_d66d7470a7a213b0" executePipeline :: Ptr Measurement -> - Ptr DataPipeline -> - IO Unit +executePipeline = fromBaseForeignType executePipeline_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e925d3ce6e5fb395" runProcessor_base :: BaseForeignType (Ptr Measurement -> + Ptr Processor -> + IO Unit) {-| __C declaration:__ @runProcessor@ __defined at:__ @functions\/callbacks.h:80:6@ @@ -1651,8 +1809,41 @@ foreign import ccall safe "hs_bindgen_d66d7470a7a213b0" executePipeline :: Ptr M __unique:__ @test_functionscallbacks_Example_Unsafe_runProcessor@ -} -foreign import ccall safe "hs_bindgen_e925d3ce6e5fb395" runProcessor :: Ptr Measurement -> - Ptr Processor -> IO Unit +runProcessor :: Ptr Measurement -> Ptr Processor -> IO Unit +{-| __C declaration:__ @runProcessor@ + + __defined at:__ @functions\/callbacks.h:80:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_runProcessor@ +-} +runProcessor = fromBaseForeignType runProcessor_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1e432e1595a1ef55" processMeasurementWithValidation_base :: BaseForeignType (Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + DataValidator -> + CInt -> + IO Unit) -> + DataValidator -> + IO Unit) -> + IO Unit) +{-| __C declaration:__ @processMeasurementWithValidation@ + + __defined at:__ @functions\/callbacks.h:85:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_processMeasurementWithValidation@ +-} +processMeasurementWithValidation :: Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + DataValidator -> CInt -> IO Unit) -> + DataValidator -> IO Unit) -> + IO Unit {-| __C declaration:__ @processMeasurementWithValidation@ __defined at:__ @functions\/callbacks.h:85:6@ @@ -1661,15 +1852,12 @@ foreign import ccall safe "hs_bindgen_e925d3ce6e5fb395" runProcessor :: Ptr Meas __unique:__ @test_functionscallbacks_Example_Unsafe_processMeasurementWithValidation@ -} -foreign import ccall safe "hs_bindgen_1e432e1595a1ef55" processMeasurementWithValidation :: Ptr Measurement -> - FunPtr (Ptr Measurement -> - FunPtr (Ptr Measurement -> - DataValidator -> - CInt -> - IO Unit) -> - DataValidator -> - IO Unit) -> - IO Unit +processMeasurementWithValidation = fromBaseForeignType processMeasurementWithValidation_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d5cd030edf2e0364" f_base :: BaseForeignType (FunPtr (Foo -> + IO Unit) -> + IO Unit) {-| __C declaration:__ @f@ __defined at:__ @functions\/callbacks.h:96:6@ @@ -1678,9 +1866,21 @@ foreign import ccall safe "hs_bindgen_1e432e1595a1ef55" processMeasurementWithVa __unique:__ @test_functionscallbacks_Example_Unsafe_f@ -} -foreign import ccall safe "hs_bindgen_d5cd030edf2e0364" f :: FunPtr (Foo -> - IO Unit) -> - IO Unit +f :: FunPtr (Foo -> IO Unit) -> IO Unit +{-| __C declaration:__ @f@ + + __defined at:__ @functions\/callbacks.h:96:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_f@ +-} +f = fromBaseForeignType f_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a10eec74074627ba" f2_base :: BaseForeignType (FunPtr (Foo2 -> + IO Unit) -> + IO Unit) {-| __C declaration:__ @f2@ __defined at:__ @functions\/callbacks.h:97:6@ @@ -1689,9 +1889,22 @@ foreign import ccall safe "hs_bindgen_d5cd030edf2e0364" f :: FunPtr (Foo -> __unique:__ @test_functionscallbacks_Example_Unsafe_f2@ -} -foreign import ccall safe "hs_bindgen_a10eec74074627ba" f2 :: FunPtr (Foo2 -> - IO Unit) -> - IO Unit +f2 :: FunPtr (Foo2 -> IO Unit) -> IO Unit +{-| __C declaration:__ @f2@ + + __defined at:__ @functions\/callbacks.h:97:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_f2@ +-} +f2 = fromBaseForeignType f2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d07f3a3e526e7017" readFileWithProcessor_base :: BaseForeignType (FunPtr (CInt -> + IO Unit) -> + CInt -> + IO CInt) {-| __C declaration:__ @readFileWithProcessor@ __defined at:__ @functions\/callbacks.h:4:5@ @@ -1700,9 +1913,32 @@ foreign import ccall safe "hs_bindgen_a10eec74074627ba" f2 :: FunPtr (Foo2 -> __unique:__ @test_functionscallbacks_Example_Unsafe_readFileWithProcessor@ -} -foreign import ccall safe "hs_bindgen_d07f3a3e526e7017" readFileWithProcessor :: FunPtr (CInt -> - IO Unit) -> - CInt -> IO CInt +readFileWithProcessor :: FunPtr (CInt -> IO Unit) -> + CInt -> IO CInt +{-| __C declaration:__ @readFileWithProcessor@ + + __defined at:__ @functions\/callbacks.h:4:5@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_readFileWithProcessor@ +-} +readFileWithProcessor = fromBaseForeignType readFileWithProcessor_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cb0219aedd5afed5" watchTemperature_base :: BaseForeignType (FunPtr (CInt -> + IO Unit) -> + CInt -> + IO Unit) +{-| __C declaration:__ @watchTemperature@ + + __defined at:__ @functions\/callbacks.h:5:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_watchTemperature@ +-} +watchTemperature :: FunPtr (CInt -> IO Unit) -> CInt -> IO Unit {-| __C declaration:__ @watchTemperature@ __defined at:__ @functions\/callbacks.h:5:6@ @@ -1711,9 +1947,20 @@ foreign import ccall safe "hs_bindgen_d07f3a3e526e7017" readFileWithProcessor :: __unique:__ @test_functionscallbacks_Example_Unsafe_watchTemperature@ -} -foreign import ccall safe "hs_bindgen_cb0219aedd5afed5" watchTemperature :: FunPtr (CInt -> - IO Unit) -> - CInt -> IO Unit +watchTemperature = fromBaseForeignType watchTemperature_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d96938841a039f9b" onFileOpened_base :: BaseForeignType (FileOpenedNotification -> + IO Unit) +{-| __C declaration:__ @onFileOpened@ + + __defined at:__ @functions\/callbacks.h:14:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onFileOpened@ +-} +onFileOpened :: FileOpenedNotification -> IO Unit {-| __C declaration:__ @onFileOpened@ __defined at:__ @functions\/callbacks.h:14:6@ @@ -1722,8 +1969,11 @@ foreign import ccall safe "hs_bindgen_cb0219aedd5afed5" watchTemperature :: FunP __unique:__ @test_functionscallbacks_Example_Unsafe_onFileOpened@ -} -foreign import ccall safe "hs_bindgen_d96938841a039f9b" onFileOpened :: FileOpenedNotification -> - IO Unit +onFileOpened = fromBaseForeignType onFileOpened_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3cb24888fc3e1751" onProgressChanged_base :: BaseForeignType (ProgressUpdate -> + IO Unit) {-| __C declaration:__ @onProgressChanged@ __defined at:__ @functions\/callbacks.h:15:6@ @@ -1732,8 +1982,30 @@ foreign import ccall safe "hs_bindgen_d96938841a039f9b" onFileOpened :: FileOpen __unique:__ @test_functionscallbacks_Example_Unsafe_onProgressChanged@ -} -foreign import ccall safe "hs_bindgen_3cb24888fc3e1751" onProgressChanged :: ProgressUpdate -> - IO Unit +onProgressChanged :: ProgressUpdate -> IO Unit +{-| __C declaration:__ @onProgressChanged@ + + __defined at:__ @functions\/callbacks.h:15:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onProgressChanged@ +-} +onProgressChanged = fromBaseForeignType onProgressChanged_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_567ea6dc040b50a1" validateInput_base :: BaseForeignType (DataValidator -> + CInt -> + IO CInt) +{-| __C declaration:__ @validateInput@ + + __defined at:__ @functions\/callbacks.h:16:5@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_validateInput@ +-} +validateInput :: DataValidator -> CInt -> IO CInt {-| __C declaration:__ @validateInput@ __defined at:__ @functions\/callbacks.h:16:5@ @@ -1742,8 +2014,11 @@ foreign import ccall safe "hs_bindgen_3cb24888fc3e1751" onProgressChanged :: Pro __unique:__ @test_functionscallbacks_Example_Unsafe_validateInput@ -} -foreign import ccall safe "hs_bindgen_567ea6dc040b50a1" validateInput :: DataValidator -> - CInt -> IO CInt +validateInput = fromBaseForeignType validateInput_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aab80c08edfa6b4b" onNewMeasurement_base :: BaseForeignType (MeasurementReceived -> + IO Unit) {-| __C declaration:__ @onNewMeasurement@ __defined at:__ @functions\/callbacks.h:27:6@ @@ -1752,8 +2027,20 @@ foreign import ccall safe "hs_bindgen_567ea6dc040b50a1" validateInput :: DataVal __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement@ -} -foreign import ccall safe "hs_bindgen_aab80c08edfa6b4b" onNewMeasurement :: MeasurementReceived -> - IO Unit +onNewMeasurement :: MeasurementReceived -> IO Unit +{-| __C declaration:__ @onNewMeasurement@ + + __defined at:__ @functions\/callbacks.h:27:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement@ +-} +onNewMeasurement = fromBaseForeignType onNewMeasurement_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6c8fae51df7c46a1" onNewMeasurement2_base :: BaseForeignType (MeasurementReceived2 -> + IO Unit) {-| __C declaration:__ @onNewMeasurement2@ __defined at:__ @functions\/callbacks.h:30:6@ @@ -1762,8 +2049,20 @@ foreign import ccall safe "hs_bindgen_aab80c08edfa6b4b" onNewMeasurement :: Meas __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement2@ -} -foreign import ccall safe "hs_bindgen_6c8fae51df7c46a1" onNewMeasurement2 :: MeasurementReceived2 -> - IO Unit +onNewMeasurement2 :: MeasurementReceived2 -> IO Unit +{-| __C declaration:__ @onNewMeasurement2@ + + __defined at:__ @functions\/callbacks.h:30:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onNewMeasurement2@ +-} +onNewMeasurement2 = fromBaseForeignType onNewMeasurement2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d44afeb36d2ae523" onBufferReady_base :: BaseForeignType (SampleBufferFull -> + IO Unit) {-| __C declaration:__ @onBufferReady@ __defined at:__ @functions\/callbacks.h:33:6@ @@ -1772,8 +2071,26 @@ foreign import ccall safe "hs_bindgen_6c8fae51df7c46a1" onNewMeasurement2 :: Mea __unique:__ @test_functionscallbacks_Example_Unsafe_onBufferReady@ -} -foreign import ccall safe "hs_bindgen_d44afeb36d2ae523" onBufferReady :: SampleBufferFull -> - IO Unit +onBufferReady :: SampleBufferFull -> IO Unit +{-| __C declaration:__ @onBufferReady@ + + __defined at:__ @functions\/callbacks.h:33:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_onBufferReady@ +-} +onBufferReady = fromBaseForeignType onBufferReady_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_523fee13fb646cad" transformMeasurement_base :: BaseForeignType (Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (CDouble -> + CInt -> + IO CDouble) -> + CInt -> + IO Unit) -> + IO Unit) {-| __C declaration:__ @transformMeasurement@ __defined at:__ @functions\/callbacks.h:38:6@ @@ -1782,14 +2099,26 @@ foreign import ccall safe "hs_bindgen_d44afeb36d2ae523" onBufferReady :: SampleB __unique:__ @test_functionscallbacks_Example_Unsafe_transformMeasurement@ -} -foreign import ccall safe "hs_bindgen_523fee13fb646cad" transformMeasurement :: Ptr Measurement -> - FunPtr (Ptr Measurement -> - FunPtr (CDouble -> - CInt -> - IO CDouble) -> - CInt -> - IO Unit) -> - IO Unit +transformMeasurement :: Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (CDouble -> CInt -> IO CDouble) -> CInt -> IO Unit) -> + IO Unit +{-| __C declaration:__ @transformMeasurement@ + + __defined at:__ @functions\/callbacks.h:38:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_transformMeasurement@ +-} +transformMeasurement = fromBaseForeignType transformMeasurement_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_98d0c5bd1271eeb7" processWithCallbacks_base :: BaseForeignType (FunPtr (Ptr Measurement -> + FileOpenedNotification -> + CInt -> + IO Unit) -> + IO Unit) {-| __C declaration:__ @processWithCallbacks@ __defined at:__ @functions\/callbacks.h:43:6@ @@ -1798,11 +2127,31 @@ foreign import ccall safe "hs_bindgen_523fee13fb646cad" transformMeasurement :: __unique:__ @test_functionscallbacks_Example_Unsafe_processWithCallbacks@ -} -foreign import ccall safe "hs_bindgen_98d0c5bd1271eeb7" processWithCallbacks :: FunPtr (Ptr Measurement -> - FileOpenedNotification -> - CInt -> - IO Unit) -> - IO Unit +processWithCallbacks :: FunPtr (Ptr Measurement -> + FileOpenedNotification -> CInt -> IO Unit) -> + IO Unit +{-| __C declaration:__ @processWithCallbacks@ + + __defined at:__ @functions\/callbacks.h:43:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_processWithCallbacks@ +-} +processWithCallbacks = fromBaseForeignType processWithCallbacks_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b96f4d4d7893e301" registerHandler_base :: BaseForeignType (Ptr MeasurementHandler -> + IO Unit) +{-| __C declaration:__ @registerHandler@ + + __defined at:__ @functions\/callbacks.h:56:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_registerHandler@ +-} +registerHandler :: Ptr MeasurementHandler -> IO Unit {-| __C declaration:__ @registerHandler@ __defined at:__ @functions\/callbacks.h:56:6@ @@ -1811,8 +2160,21 @@ foreign import ccall safe "hs_bindgen_98d0c5bd1271eeb7" processWithCallbacks :: __unique:__ @test_functionscallbacks_Example_Unsafe_registerHandler@ -} -foreign import ccall safe "hs_bindgen_b96f4d4d7893e301" registerHandler :: Ptr MeasurementHandler -> - IO Unit +registerHandler = fromBaseForeignType registerHandler_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c062ded603732aae" executePipeline_base :: BaseForeignType (Ptr Measurement -> + Ptr DataPipeline -> + IO Unit) +{-| __C declaration:__ @executePipeline@ + + __defined at:__ @functions\/callbacks.h:64:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_executePipeline@ +-} +executePipeline :: Ptr Measurement -> Ptr DataPipeline -> IO Unit {-| __C declaration:__ @executePipeline@ __defined at:__ @functions\/callbacks.h:64:6@ @@ -1821,9 +2183,12 @@ foreign import ccall safe "hs_bindgen_b96f4d4d7893e301" registerHandler :: Ptr M __unique:__ @test_functionscallbacks_Example_Unsafe_executePipeline@ -} -foreign import ccall safe "hs_bindgen_c062ded603732aae" executePipeline :: Ptr Measurement -> - Ptr DataPipeline -> - IO Unit +executePipeline = fromBaseForeignType executePipeline_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_02d41a1f48eebff7" runProcessor_base :: BaseForeignType (Ptr Measurement -> + Ptr Processor -> + IO Unit) {-| __C declaration:__ @runProcessor@ __defined at:__ @functions\/callbacks.h:80:6@ @@ -1832,8 +2197,27 @@ foreign import ccall safe "hs_bindgen_c062ded603732aae" executePipeline :: Ptr M __unique:__ @test_functionscallbacks_Example_Unsafe_runProcessor@ -} -foreign import ccall safe "hs_bindgen_02d41a1f48eebff7" runProcessor :: Ptr Measurement -> - Ptr Processor -> IO Unit +runProcessor :: Ptr Measurement -> Ptr Processor -> IO Unit +{-| __C declaration:__ @runProcessor@ + + __defined at:__ @functions\/callbacks.h:80:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_runProcessor@ +-} +runProcessor = fromBaseForeignType runProcessor_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_39704c8b14c2ce3c" processMeasurementWithValidation_base :: BaseForeignType (Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + DataValidator -> + CInt -> + IO Unit) -> + DataValidator -> + IO Unit) -> + IO Unit) {-| __C declaration:__ @processMeasurementWithValidation@ __defined at:__ @functions\/callbacks.h:85:6@ @@ -1842,15 +2226,35 @@ foreign import ccall safe "hs_bindgen_02d41a1f48eebff7" runProcessor :: Ptr Meas __unique:__ @test_functionscallbacks_Example_Unsafe_processMeasurementWithValidation@ -} -foreign import ccall safe "hs_bindgen_39704c8b14c2ce3c" processMeasurementWithValidation :: Ptr Measurement -> - FunPtr (Ptr Measurement -> - FunPtr (Ptr Measurement -> - DataValidator -> - CInt -> - IO Unit) -> - DataValidator -> - IO Unit) -> - IO Unit +processMeasurementWithValidation :: Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + DataValidator -> CInt -> IO Unit) -> + DataValidator -> IO Unit) -> + IO Unit +{-| __C declaration:__ @processMeasurementWithValidation@ + + __defined at:__ @functions\/callbacks.h:85:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_processMeasurementWithValidation@ +-} +processMeasurementWithValidation = fromBaseForeignType processMeasurementWithValidation_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_10c383cdf6eddb0d" f_base :: BaseForeignType (FunPtr (Foo -> + IO Unit) -> + IO Unit) +{-| __C declaration:__ @f@ + + __defined at:__ @functions\/callbacks.h:96:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_f@ +-} +f :: FunPtr (Foo -> IO Unit) -> IO Unit {-| __C declaration:__ @f@ __defined at:__ @functions\/callbacks.h:96:6@ @@ -1859,9 +2263,12 @@ foreign import ccall safe "hs_bindgen_39704c8b14c2ce3c" processMeasurementWithVa __unique:__ @test_functionscallbacks_Example_Unsafe_f@ -} -foreign import ccall safe "hs_bindgen_10c383cdf6eddb0d" f :: FunPtr (Foo -> - IO Unit) -> - IO Unit +f = fromBaseForeignType f_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_831d03bed0065a4e" f2_base :: BaseForeignType (FunPtr (Foo2 -> + IO Unit) -> + IO Unit) {-| __C declaration:__ @f2@ __defined at:__ @functions\/callbacks.h:97:6@ @@ -1870,15 +2277,30 @@ foreign import ccall safe "hs_bindgen_10c383cdf6eddb0d" f :: FunPtr (Foo -> __unique:__ @test_functionscallbacks_Example_Unsafe_f2@ -} -foreign import ccall safe "hs_bindgen_831d03bed0065a4e" f2 :: FunPtr (Foo2 -> - IO Unit) -> - IO Unit +f2 :: FunPtr (Foo2 -> IO Unit) -> IO Unit +{-| __C declaration:__ @f2@ + + __defined at:__ @functions\/callbacks.h:97:6@ + + __exported by:__ @functions\/callbacks.h@ + + __unique:__ @test_functionscallbacks_Example_Unsafe_f2@ +-} +f2 = fromBaseForeignType f2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_11c3318ecc076134" hs_bindgen_11c3318ecc076134_base :: BaseForeignType (IO (FunPtr (FunPtr (CInt -> + IO Unit) -> + CInt -> + IO CInt))) +{-| __unique:__ @test_functionscallbacks_Example_get_readFileWithProcessor_ptr@ +-} +hs_bindgen_11c3318ecc076134 :: IO (FunPtr (FunPtr (CInt -> + IO Unit) -> + CInt -> IO CInt)) {-| __unique:__ @test_functionscallbacks_Example_get_readFileWithProcessor_ptr@ -} -foreign import ccall safe "hs_bindgen_11c3318ecc076134" hs_bindgen_11c3318ecc076134 :: IO (FunPtr (FunPtr (CInt -> - IO Unit) -> - CInt -> - IO CInt)) +hs_bindgen_11c3318ecc076134 = fromBaseForeignType hs_bindgen_11c3318ecc076134_base {-# NOINLINE readFileWithProcessor_ptr #-} {-| __C declaration:__ @readFileWithProcessor@ @@ -1895,12 +2317,20 @@ readFileWithProcessor_ptr :: FunPtr (FunPtr (CInt -> IO Unit) -> __exported by:__ @functions\/callbacks.h@ -} readFileWithProcessor_ptr = unsafePerformIO hs_bindgen_11c3318ecc076134 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_812229d77f36833a" hs_bindgen_812229d77f36833a_base :: BaseForeignType (IO (FunPtr (FunPtr (CInt -> + IO Unit) -> + CInt -> + IO Unit))) {-| __unique:__ @test_functionscallbacks_Example_get_watchTemperature_ptr@ -} -foreign import ccall safe "hs_bindgen_812229d77f36833a" hs_bindgen_812229d77f36833a :: IO (FunPtr (FunPtr (CInt -> - IO Unit) -> - CInt -> - IO Unit)) +hs_bindgen_812229d77f36833a :: IO (FunPtr (FunPtr (CInt -> + IO Unit) -> + CInt -> IO Unit)) +{-| __unique:__ @test_functionscallbacks_Example_get_watchTemperature_ptr@ +-} +hs_bindgen_812229d77f36833a = fromBaseForeignType hs_bindgen_812229d77f36833a_base {-# NOINLINE watchTemperature_ptr #-} {-| __C declaration:__ @watchTemperature@ @@ -1917,10 +2347,17 @@ watchTemperature_ptr :: FunPtr (FunPtr (CInt -> IO Unit) -> __exported by:__ @functions\/callbacks.h@ -} watchTemperature_ptr = unsafePerformIO hs_bindgen_812229d77f36833a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cd162abdd104aa42" hs_bindgen_cd162abdd104aa42_base :: BaseForeignType (IO (FunPtr (FileOpenedNotification -> + IO Unit))) +{-| __unique:__ @test_functionscallbacks_Example_get_onFileOpened_ptr@ +-} +hs_bindgen_cd162abdd104aa42 :: IO (FunPtr (FileOpenedNotification -> + IO Unit)) {-| __unique:__ @test_functionscallbacks_Example_get_onFileOpened_ptr@ -} -foreign import ccall safe "hs_bindgen_cd162abdd104aa42" hs_bindgen_cd162abdd104aa42 :: IO (FunPtr (FileOpenedNotification -> - IO Unit)) +hs_bindgen_cd162abdd104aa42 = fromBaseForeignType hs_bindgen_cd162abdd104aa42_base {-# NOINLINE onFileOpened_ptr #-} {-| __C declaration:__ @onFileOpened@ @@ -1936,10 +2373,17 @@ onFileOpened_ptr :: FunPtr (FileOpenedNotification -> IO Unit) __exported by:__ @functions\/callbacks.h@ -} onFileOpened_ptr = unsafePerformIO hs_bindgen_cd162abdd104aa42 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b66e61e98e8145a4" hs_bindgen_b66e61e98e8145a4_base :: BaseForeignType (IO (FunPtr (ProgressUpdate -> + IO Unit))) {-| __unique:__ @test_functionscallbacks_Example_get_onProgressChanged_ptr@ -} -foreign import ccall safe "hs_bindgen_b66e61e98e8145a4" hs_bindgen_b66e61e98e8145a4 :: IO (FunPtr (ProgressUpdate -> - IO Unit)) +hs_bindgen_b66e61e98e8145a4 :: IO (FunPtr (ProgressUpdate -> + IO Unit)) +{-| __unique:__ @test_functionscallbacks_Example_get_onProgressChanged_ptr@ +-} +hs_bindgen_b66e61e98e8145a4 = fromBaseForeignType hs_bindgen_b66e61e98e8145a4_base {-# NOINLINE onProgressChanged_ptr #-} {-| __C declaration:__ @onProgressChanged@ @@ -1955,11 +2399,18 @@ onProgressChanged_ptr :: FunPtr (ProgressUpdate -> IO Unit) __exported by:__ @functions\/callbacks.h@ -} onProgressChanged_ptr = unsafePerformIO hs_bindgen_b66e61e98e8145a4 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4c20e93be5c3b5bb" hs_bindgen_4c20e93be5c3b5bb_base :: BaseForeignType (IO (FunPtr (DataValidator -> + CInt -> + IO CInt))) {-| __unique:__ @test_functionscallbacks_Example_get_validateInput_ptr@ -} -foreign import ccall safe "hs_bindgen_4c20e93be5c3b5bb" hs_bindgen_4c20e93be5c3b5bb :: IO (FunPtr (DataValidator -> - CInt -> - IO CInt)) +hs_bindgen_4c20e93be5c3b5bb :: IO (FunPtr (DataValidator -> + CInt -> IO CInt)) +{-| __unique:__ @test_functionscallbacks_Example_get_validateInput_ptr@ +-} +hs_bindgen_4c20e93be5c3b5bb = fromBaseForeignType hs_bindgen_4c20e93be5c3b5bb_base {-# NOINLINE validateInput_ptr #-} {-| __C declaration:__ @validateInput@ @@ -1975,10 +2426,17 @@ validateInput_ptr :: FunPtr (DataValidator -> CInt -> IO CInt) __exported by:__ @functions\/callbacks.h@ -} validateInput_ptr = unsafePerformIO hs_bindgen_4c20e93be5c3b5bb +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f0fa88e6072c2d7a" hs_bindgen_f0fa88e6072c2d7a_base :: BaseForeignType (IO (FunPtr (MeasurementReceived -> + IO Unit))) {-| __unique:__ @test_functionscallbacks_Example_get_onNewMeasurement_ptr@ -} -foreign import ccall safe "hs_bindgen_f0fa88e6072c2d7a" hs_bindgen_f0fa88e6072c2d7a :: IO (FunPtr (MeasurementReceived -> - IO Unit)) +hs_bindgen_f0fa88e6072c2d7a :: IO (FunPtr (MeasurementReceived -> + IO Unit)) +{-| __unique:__ @test_functionscallbacks_Example_get_onNewMeasurement_ptr@ +-} +hs_bindgen_f0fa88e6072c2d7a = fromBaseForeignType hs_bindgen_f0fa88e6072c2d7a_base {-# NOINLINE onNewMeasurement_ptr #-} {-| __C declaration:__ @onNewMeasurement@ @@ -1994,10 +2452,17 @@ onNewMeasurement_ptr :: FunPtr (MeasurementReceived -> IO Unit) __exported by:__ @functions\/callbacks.h@ -} onNewMeasurement_ptr = unsafePerformIO hs_bindgen_f0fa88e6072c2d7a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c72d8638d47aae13" hs_bindgen_c72d8638d47aae13_base :: BaseForeignType (IO (FunPtr (MeasurementReceived2 -> + IO Unit))) +{-| __unique:__ @test_functionscallbacks_Example_get_onNewMeasurement2_ptr@ +-} +hs_bindgen_c72d8638d47aae13 :: IO (FunPtr (MeasurementReceived2 -> + IO Unit)) {-| __unique:__ @test_functionscallbacks_Example_get_onNewMeasurement2_ptr@ -} -foreign import ccall safe "hs_bindgen_c72d8638d47aae13" hs_bindgen_c72d8638d47aae13 :: IO (FunPtr (MeasurementReceived2 -> - IO Unit)) +hs_bindgen_c72d8638d47aae13 = fromBaseForeignType hs_bindgen_c72d8638d47aae13_base {-# NOINLINE onNewMeasurement2_ptr #-} {-| __C declaration:__ @onNewMeasurement2@ @@ -2013,10 +2478,17 @@ onNewMeasurement2_ptr :: FunPtr (MeasurementReceived2 -> IO Unit) __exported by:__ @functions\/callbacks.h@ -} onNewMeasurement2_ptr = unsafePerformIO hs_bindgen_c72d8638d47aae13 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7b54895b95bee198" hs_bindgen_7b54895b95bee198_base :: BaseForeignType (IO (FunPtr (SampleBufferFull -> + IO Unit))) +{-| __unique:__ @test_functionscallbacks_Example_get_onBufferReady_ptr@ +-} +hs_bindgen_7b54895b95bee198 :: IO (FunPtr (SampleBufferFull -> + IO Unit)) {-| __unique:__ @test_functionscallbacks_Example_get_onBufferReady_ptr@ -} -foreign import ccall safe "hs_bindgen_7b54895b95bee198" hs_bindgen_7b54895b95bee198 :: IO (FunPtr (SampleBufferFull -> - IO Unit)) +hs_bindgen_7b54895b95bee198 = fromBaseForeignType hs_bindgen_7b54895b95bee198_base {-# NOINLINE onBufferReady_ptr #-} {-| __C declaration:__ @onBufferReady@ @@ -2032,16 +2504,26 @@ onBufferReady_ptr :: FunPtr (SampleBufferFull -> IO Unit) __exported by:__ @functions\/callbacks.h@ -} onBufferReady_ptr = unsafePerformIO hs_bindgen_7b54895b95bee198 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4215bdb12daf9024" hs_bindgen_4215bdb12daf9024_base :: BaseForeignType (IO (FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (CDouble -> + CInt -> + IO CDouble) -> + CInt -> + IO Unit) -> + IO Unit))) +{-| __unique:__ @test_functionscallbacks_Example_get_transformMeasurement_ptr@ +-} +hs_bindgen_4215bdb12daf9024 :: IO (FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (CDouble -> CInt -> IO CDouble) -> + CInt -> IO Unit) -> + IO Unit)) {-| __unique:__ @test_functionscallbacks_Example_get_transformMeasurement_ptr@ -} -foreign import ccall safe "hs_bindgen_4215bdb12daf9024" hs_bindgen_4215bdb12daf9024 :: IO (FunPtr (Ptr Measurement -> - FunPtr (Ptr Measurement -> - FunPtr (CDouble -> - CInt -> - IO CDouble) -> - CInt -> - IO Unit) -> - IO Unit)) +hs_bindgen_4215bdb12daf9024 = fromBaseForeignType hs_bindgen_4215bdb12daf9024_base {-# NOINLINE transformMeasurement_ptr #-} {-| __C declaration:__ @transformMeasurement@ @@ -2061,13 +2543,21 @@ transformMeasurement_ptr :: FunPtr (Ptr Measurement -> __exported by:__ @functions\/callbacks.h@ -} transformMeasurement_ptr = unsafePerformIO hs_bindgen_4215bdb12daf9024 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_701c0161802d878b" hs_bindgen_701c0161802d878b_base :: BaseForeignType (IO (FunPtr (FunPtr (Ptr Measurement -> + FileOpenedNotification -> + CInt -> + IO Unit) -> + IO Unit))) +{-| __unique:__ @test_functionscallbacks_Example_get_processWithCallbacks_ptr@ +-} +hs_bindgen_701c0161802d878b :: IO (FunPtr (FunPtr (Ptr Measurement -> + FileOpenedNotification -> CInt -> IO Unit) -> + IO Unit)) {-| __unique:__ @test_functionscallbacks_Example_get_processWithCallbacks_ptr@ -} -foreign import ccall safe "hs_bindgen_701c0161802d878b" hs_bindgen_701c0161802d878b :: IO (FunPtr (FunPtr (Ptr Measurement -> - FileOpenedNotification -> - CInt -> - IO Unit) -> - IO Unit)) +hs_bindgen_701c0161802d878b = fromBaseForeignType hs_bindgen_701c0161802d878b_base {-# NOINLINE processWithCallbacks_ptr #-} {-| __C declaration:__ @processWithCallbacks@ @@ -2085,10 +2575,17 @@ processWithCallbacks_ptr :: FunPtr (FunPtr (Ptr Measurement -> __exported by:__ @functions\/callbacks.h@ -} processWithCallbacks_ptr = unsafePerformIO hs_bindgen_701c0161802d878b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_90c9d96723cea577" hs_bindgen_90c9d96723cea577_base :: BaseForeignType (IO (FunPtr (Ptr MeasurementHandler -> + IO Unit))) +{-| __unique:__ @test_functionscallbacks_Example_get_registerHandler_ptr@ +-} +hs_bindgen_90c9d96723cea577 :: IO (FunPtr (Ptr MeasurementHandler -> + IO Unit)) {-| __unique:__ @test_functionscallbacks_Example_get_registerHandler_ptr@ -} -foreign import ccall safe "hs_bindgen_90c9d96723cea577" hs_bindgen_90c9d96723cea577 :: IO (FunPtr (Ptr MeasurementHandler -> - IO Unit)) +hs_bindgen_90c9d96723cea577 = fromBaseForeignType hs_bindgen_90c9d96723cea577_base {-# NOINLINE registerHandler_ptr #-} {-| __C declaration:__ @registerHandler@ @@ -2104,11 +2601,18 @@ registerHandler_ptr :: FunPtr (Ptr MeasurementHandler -> IO Unit) __exported by:__ @functions\/callbacks.h@ -} registerHandler_ptr = unsafePerformIO hs_bindgen_90c9d96723cea577 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bc33471040d45469" hs_bindgen_bc33471040d45469_base :: BaseForeignType (IO (FunPtr (Ptr Measurement -> + Ptr DataPipeline -> + IO Unit))) {-| __unique:__ @test_functionscallbacks_Example_get_executePipeline_ptr@ -} -foreign import ccall safe "hs_bindgen_bc33471040d45469" hs_bindgen_bc33471040d45469 :: IO (FunPtr (Ptr Measurement -> - Ptr DataPipeline -> - IO Unit)) +hs_bindgen_bc33471040d45469 :: IO (FunPtr (Ptr Measurement -> + Ptr DataPipeline -> IO Unit)) +{-| __unique:__ @test_functionscallbacks_Example_get_executePipeline_ptr@ +-} +hs_bindgen_bc33471040d45469 = fromBaseForeignType hs_bindgen_bc33471040d45469_base {-# NOINLINE executePipeline_ptr #-} {-| __C declaration:__ @executePipeline@ @@ -2125,11 +2629,18 @@ executePipeline_ptr :: FunPtr (Ptr Measurement -> __exported by:__ @functions\/callbacks.h@ -} executePipeline_ptr = unsafePerformIO hs_bindgen_bc33471040d45469 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_86a8e8897172172b" hs_bindgen_86a8e8897172172b_base :: BaseForeignType (IO (FunPtr (Ptr Measurement -> + Ptr Processor -> + IO Unit))) {-| __unique:__ @test_functionscallbacks_Example_get_runProcessor_ptr@ -} -foreign import ccall safe "hs_bindgen_86a8e8897172172b" hs_bindgen_86a8e8897172172b :: IO (FunPtr (Ptr Measurement -> - Ptr Processor -> - IO Unit)) +hs_bindgen_86a8e8897172172b :: IO (FunPtr (Ptr Measurement -> + Ptr Processor -> IO Unit)) +{-| __unique:__ @test_functionscallbacks_Example_get_runProcessor_ptr@ +-} +hs_bindgen_86a8e8897172172b = fromBaseForeignType hs_bindgen_86a8e8897172172b_base {-# NOINLINE runProcessor_ptr #-} {-| __C declaration:__ @runProcessor@ @@ -2146,17 +2657,28 @@ runProcessor_ptr :: FunPtr (Ptr Measurement -> __exported by:__ @functions\/callbacks.h@ -} runProcessor_ptr = unsafePerformIO hs_bindgen_86a8e8897172172b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f4667aed4d51fd75" hs_bindgen_f4667aed4d51fd75_base :: BaseForeignType (IO (FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + DataValidator -> + CInt -> + IO Unit) -> + DataValidator -> + IO Unit) -> + IO Unit))) {-| __unique:__ @test_functionscallbacks_Example_get_processMeasurementWithValidation_ptr@ -} -foreign import ccall safe "hs_bindgen_f4667aed4d51fd75" hs_bindgen_f4667aed4d51fd75 :: IO (FunPtr (Ptr Measurement -> - FunPtr (Ptr Measurement -> - FunPtr (Ptr Measurement -> - DataValidator -> - CInt -> - IO Unit) -> - DataValidator -> - IO Unit) -> - IO Unit)) +hs_bindgen_f4667aed4d51fd75 :: IO (FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + FunPtr (Ptr Measurement -> + DataValidator -> CInt -> IO Unit) -> + DataValidator -> IO Unit) -> + IO Unit)) +{-| __unique:__ @test_functionscallbacks_Example_get_processMeasurementWithValidation_ptr@ +-} +hs_bindgen_f4667aed4d51fd75 = fromBaseForeignType hs_bindgen_f4667aed4d51fd75_base {-# NOINLINE processMeasurementWithValidation_ptr #-} {-| __C declaration:__ @processMeasurementWithValidation@ @@ -2177,11 +2699,19 @@ processMeasurementWithValidation_ptr :: FunPtr (Ptr Measurement -> __exported by:__ @functions\/callbacks.h@ -} processMeasurementWithValidation_ptr = unsafePerformIO hs_bindgen_f4667aed4d51fd75 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_77b468218b567b37" hs_bindgen_77b468218b567b37_base :: BaseForeignType (IO (FunPtr (FunPtr (Foo -> + IO Unit) -> + IO Unit))) {-| __unique:__ @test_functionscallbacks_Example_get_f_ptr@ -} -foreign import ccall safe "hs_bindgen_77b468218b567b37" hs_bindgen_77b468218b567b37 :: IO (FunPtr (FunPtr (Foo -> - IO Unit) -> - IO Unit)) +hs_bindgen_77b468218b567b37 :: IO (FunPtr (FunPtr (Foo -> + IO Unit) -> + IO Unit)) +{-| __unique:__ @test_functionscallbacks_Example_get_f_ptr@ +-} +hs_bindgen_77b468218b567b37 = fromBaseForeignType hs_bindgen_77b468218b567b37_base {-# NOINLINE f_ptr #-} {-| __C declaration:__ @f@ @@ -2197,11 +2727,19 @@ f_ptr :: FunPtr (FunPtr (Foo -> IO Unit) -> IO Unit) __exported by:__ @functions\/callbacks.h@ -} f_ptr = unsafePerformIO hs_bindgen_77b468218b567b37 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d5a4de10d670d97d" hs_bindgen_d5a4de10d670d97d_base :: BaseForeignType (IO (FunPtr (FunPtr (Foo2 -> + IO Unit) -> + IO Unit))) +{-| __unique:__ @test_functionscallbacks_Example_get_f2_ptr@ +-} +hs_bindgen_d5a4de10d670d97d :: IO (FunPtr (FunPtr (Foo2 -> + IO Unit) -> + IO Unit)) {-| __unique:__ @test_functionscallbacks_Example_get_f2_ptr@ -} -foreign import ccall safe "hs_bindgen_d5a4de10d670d97d" hs_bindgen_d5a4de10d670d97d :: IO (FunPtr (FunPtr (Foo2 -> - IO Unit) -> - IO Unit)) +hs_bindgen_d5a4de10d670d97d = fromBaseForeignType hs_bindgen_d5a4de10d670d97d_base {-# NOINLINE f2_ptr #-} {-| __C declaration:__ @f2@ diff --git a/hs-bindgen/fixtures/functions/decls_in_signature/Example/FunPtr.hs b/hs-bindgen/fixtures/functions/decls_in_signature/Example/FunPtr.hs index e2e8d5a90..0dd7dd1b7 100644 --- a/hs-bindgen/fixtures/functions/decls_in_signature/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/functions/decls_in_signature/Example/FunPtr.hs @@ -7,6 +7,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -41,10 +42,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3f49e28bee3f8746" hs_bindgen_3f49e28bee3f8746_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Opaque) -> (Ptr.Ptr Outside) -> Outside -> IO ()))) + {-| __unique:__ @test_functionsdecls_in_signature_Example_get_normal_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3f49e28bee3f8746" hs_bindgen_3f49e28bee3f8746 :: +hs_bindgen_3f49e28bee3f8746 :: IO (Ptr.FunPtr ((Ptr.Ptr Opaque) -> (Ptr.Ptr Outside) -> Outside -> IO ())) +hs_bindgen_3f49e28bee3f8746 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3f49e28bee3f8746_base {-# NOINLINE normal_ptr #-} @@ -58,10 +66,17 @@ normal_ptr :: Ptr.FunPtr ((Ptr.Ptr Opaque) -> (Ptr.Ptr Outside) -> Outside -> IO normal_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3f49e28bee3f8746 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8de29d760cad0c00" hs_bindgen_8de29d760cad0c00_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Named_struct -> IO ()))) + {-| __unique:__ @test_functionsdecls_in_signature_Example_get_f1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8de29d760cad0c00" hs_bindgen_8de29d760cad0c00 :: +hs_bindgen_8de29d760cad0c00 :: IO (Ptr.FunPtr (Named_struct -> IO ())) +hs_bindgen_8de29d760cad0c00 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8de29d760cad0c00_base {-# NOINLINE f1_ptr #-} @@ -79,10 +94,17 @@ f1_ptr :: Ptr.FunPtr (Named_struct -> IO ()) f1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8de29d760cad0c00 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7a2b955aeef7fcd9" hs_bindgen_7a2b955aeef7fcd9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Named_union -> IO ()))) + {-| __unique:__ @test_functionsdecls_in_signature_Example_get_f2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7a2b955aeef7fcd9" hs_bindgen_7a2b955aeef7fcd9 :: +hs_bindgen_7a2b955aeef7fcd9 :: IO (Ptr.FunPtr (Named_union -> IO ())) +hs_bindgen_7a2b955aeef7fcd9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7a2b955aeef7fcd9_base {-# NOINLINE f2_ptr #-} diff --git a/hs-bindgen/fixtures/functions/decls_in_signature/Example/Safe.hs b/hs-bindgen/fixtures/functions/decls_in_signature/Example/Safe.hs index 91a2cece3..21c355867 100644 --- a/hs-bindgen/fixtures/functions/decls_in_signature/Example/Safe.hs +++ b/hs-bindgen/fixtures/functions/decls_in_signature/Example/Safe.hs @@ -7,6 +7,7 @@ module Example.Safe where import qualified Foreign as F import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -35,15 +36,22 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_920e5c20f770432b" normal_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Opaque) -> (Ptr.Ptr Outside) -> (Ptr.Ptr Outside) -> IO ()) + {-| Pointer-based API for 'normal' __unique:__ @test_functionsdecls_in_signature_Example_Safe_normal@ -} -foreign import ccall safe "hs_bindgen_920e5c20f770432b" normal_wrapper :: +normal_wrapper :: Ptr.Ptr Opaque -> Ptr.Ptr Outside -> Ptr.Ptr Outside -> IO () +normal_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType normal_wrapper_base {-| __C declaration:__ @normal@ @@ -67,13 +75,20 @@ normal = \x1 -> \x2 -> F.with x2 (\y3 -> normal_wrapper x0 x1 y3) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_baea2c7a0c8b9965" f1_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Named_struct) -> IO ()) + {-| Pointer-based API for 'f1' __unique:__ @test_functionsdecls_in_signature_Example_Safe_f1@ -} -foreign import ccall safe "hs_bindgen_baea2c7a0c8b9965" f1_wrapper :: +f1_wrapper :: Ptr.Ptr Named_struct -> IO () +f1_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f1_wrapper_base {-| Error cases @@ -92,13 +107,20 @@ f1 :: -> IO () f1 = \x0 -> F.with x0 (\y1 -> f1_wrapper y1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_990d7be722ad5414" f2_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Named_union) -> IO ()) + {-| Pointer-based API for 'f2' __unique:__ @test_functionsdecls_in_signature_Example_Safe_f2@ -} -foreign import ccall safe "hs_bindgen_990d7be722ad5414" f2_wrapper :: +f2_wrapper :: Ptr.Ptr Named_union -> IO () +f2_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f2_wrapper_base {-| __C declaration:__ @f2@ diff --git a/hs-bindgen/fixtures/functions/decls_in_signature/Example/Unsafe.hs b/hs-bindgen/fixtures/functions/decls_in_signature/Example/Unsafe.hs index 2f0a5390b..c0be6aceb 100644 --- a/hs-bindgen/fixtures/functions/decls_in_signature/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/functions/decls_in_signature/Example/Unsafe.hs @@ -7,6 +7,7 @@ module Example.Unsafe where import qualified Foreign as F import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -35,15 +36,22 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_247ee31a29b7e5a8" normal_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Opaque) -> (Ptr.Ptr Outside) -> (Ptr.Ptr Outside) -> IO ()) + {-| Pointer-based API for 'normal' __unique:__ @test_functionsdecls_in_signature_Example_Unsafe_normal@ -} -foreign import ccall unsafe "hs_bindgen_247ee31a29b7e5a8" normal_wrapper :: +normal_wrapper :: Ptr.Ptr Opaque -> Ptr.Ptr Outside -> Ptr.Ptr Outside -> IO () +normal_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType normal_wrapper_base {-| __C declaration:__ @normal@ @@ -67,13 +75,20 @@ normal = \x1 -> \x2 -> F.with x2 (\y3 -> normal_wrapper x0 x1 y3) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dad6e1aa83dec458" f1_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Named_struct) -> IO ()) + {-| Pointer-based API for 'f1' __unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f1@ -} -foreign import ccall unsafe "hs_bindgen_dad6e1aa83dec458" f1_wrapper :: +f1_wrapper :: Ptr.Ptr Named_struct -> IO () +f1_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f1_wrapper_base {-| Error cases @@ -92,13 +107,20 @@ f1 :: -> IO () f1 = \x0 -> F.with x0 (\y1 -> f1_wrapper y1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e6bb0f3956383df9" f2_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Named_union) -> IO ()) + {-| Pointer-based API for 'f2' __unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f2@ -} -foreign import ccall unsafe "hs_bindgen_e6bb0f3956383df9" f2_wrapper :: +f2_wrapper :: Ptr.Ptr Named_union -> IO () +f2_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f2_wrapper_base {-| __C declaration:__ @f2@ diff --git a/hs-bindgen/fixtures/functions/decls_in_signature/th.txt b/hs-bindgen/fixtures/functions/decls_in_signature/th.txt index 8c97eeaa6..66f875ad5 100644 --- a/hs-bindgen/fixtures/functions/decls_in_signature/th.txt +++ b/hs-bindgen/fixtures/functions/decls_in_signature/th.txt @@ -270,13 +270,23 @@ instance HasCField Named_union "named_union_y" instance TyEq ty (CFieldType Named_union "named_union_y") => HasField "named_union_y" (Ptr Named_union) (Ptr ty) where getField = ptrToCField (Proxy @"named_union_y") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_920e5c20f770432b" normal_wrapper_base :: BaseForeignType (Ptr Opaque -> + Ptr Outside -> + Ptr Outside -> + IO Unit) +{-| Pointer-based API for 'normal' + +__unique:__ @test_functionsdecls_in_signature_Example_Unsafe_normal@ +-} +normal_wrapper :: Ptr Opaque -> + Ptr Outside -> Ptr Outside -> IO Unit {-| Pointer-based API for 'normal' __unique:__ @test_functionsdecls_in_signature_Example_Unsafe_normal@ -} -foreign import ccall safe "hs_bindgen_920e5c20f770432b" normal_wrapper :: Ptr Opaque -> - Ptr Outside -> - Ptr Outside -> IO Unit +normal_wrapper = fromBaseForeignType normal_wrapper_base {-| __C declaration:__ @normal@ __defined at:__ @functions\/decls_in_signature.h:7:6@ @@ -291,12 +301,20 @@ normal :: Ptr Opaque -> Ptr Outside -> Outside -> IO Unit __exported by:__ @functions\/decls_in_signature.h@ -} normal = \x_0 -> \x_1 -> \x_2 -> with x_2 (\y_3 -> normal_wrapper x_0 x_1 y_3) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_baea2c7a0c8b9965" f1_wrapper_base :: BaseForeignType (Ptr Named_struct -> + IO Unit) +{-| Pointer-based API for 'f1' + +__unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f1@ +-} +f1_wrapper :: Ptr Named_struct -> IO Unit {-| Pointer-based API for 'f1' __unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f1@ -} -foreign import ccall safe "hs_bindgen_baea2c7a0c8b9965" f1_wrapper :: Ptr Named_struct -> - IO Unit +f1_wrapper = fromBaseForeignType f1_wrapper_base {-| Error cases See 'UnexpectedAnonInSignature' for discussion (of both these error cases and the edge cases below). @@ -319,12 +337,20 @@ __defined at:__ @functions\/decls_in_signature.h:17:6@ __exported by:__ @functions\/decls_in_signature.h@ -} f1 = \x_0 -> with x_0 (\y_1 -> f1_wrapper y_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_990d7be722ad5414" f2_wrapper_base :: BaseForeignType (Ptr Named_union -> + IO Unit) +{-| Pointer-based API for 'f2' + +__unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f2@ +-} +f2_wrapper :: Ptr Named_union -> IO Unit {-| Pointer-based API for 'f2' __unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f2@ -} -foreign import ccall safe "hs_bindgen_990d7be722ad5414" f2_wrapper :: Ptr Named_union -> - IO Unit +f2_wrapper = fromBaseForeignType f2_wrapper_base {-| __C declaration:__ @f2@ __defined at:__ @functions\/decls_in_signature.h:20:6@ @@ -339,13 +365,23 @@ f2 :: Named_union -> IO Unit __exported by:__ @functions\/decls_in_signature.h@ -} f2 = \x_0 -> with x_0 (\y_1 -> f2_wrapper y_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_247ee31a29b7e5a8" normal_wrapper_base :: BaseForeignType (Ptr Opaque -> + Ptr Outside -> + Ptr Outside -> + IO Unit) +{-| Pointer-based API for 'normal' + +__unique:__ @test_functionsdecls_in_signature_Example_Unsafe_normal@ +-} +normal_wrapper :: Ptr Opaque -> + Ptr Outside -> Ptr Outside -> IO Unit {-| Pointer-based API for 'normal' __unique:__ @test_functionsdecls_in_signature_Example_Unsafe_normal@ -} -foreign import ccall safe "hs_bindgen_247ee31a29b7e5a8" normal_wrapper :: Ptr Opaque -> - Ptr Outside -> - Ptr Outside -> IO Unit +normal_wrapper = fromBaseForeignType normal_wrapper_base {-| __C declaration:__ @normal@ __defined at:__ @functions\/decls_in_signature.h:7:6@ @@ -360,12 +396,20 @@ normal :: Ptr Opaque -> Ptr Outside -> Outside -> IO Unit __exported by:__ @functions\/decls_in_signature.h@ -} normal = \x_0 -> \x_1 -> \x_2 -> with x_2 (\y_3 -> normal_wrapper x_0 x_1 y_3) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dad6e1aa83dec458" f1_wrapper_base :: BaseForeignType (Ptr Named_struct -> + IO Unit) +{-| Pointer-based API for 'f1' + +__unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f1@ +-} +f1_wrapper :: Ptr Named_struct -> IO Unit {-| Pointer-based API for 'f1' __unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f1@ -} -foreign import ccall safe "hs_bindgen_dad6e1aa83dec458" f1_wrapper :: Ptr Named_struct -> - IO Unit +f1_wrapper = fromBaseForeignType f1_wrapper_base {-| Error cases See 'UnexpectedAnonInSignature' for discussion (of both these error cases and the edge cases below). @@ -388,12 +432,20 @@ __defined at:__ @functions\/decls_in_signature.h:17:6@ __exported by:__ @functions\/decls_in_signature.h@ -} f1 = \x_0 -> with x_0 (\y_1 -> f1_wrapper y_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e6bb0f3956383df9" f2_wrapper_base :: BaseForeignType (Ptr Named_union -> + IO Unit) +{-| Pointer-based API for 'f2' + +__unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f2@ +-} +f2_wrapper :: Ptr Named_union -> IO Unit {-| Pointer-based API for 'f2' __unique:__ @test_functionsdecls_in_signature_Example_Unsafe_f2@ -} -foreign import ccall safe "hs_bindgen_e6bb0f3956383df9" f2_wrapper :: Ptr Named_union -> - IO Unit +f2_wrapper = fromBaseForeignType f2_wrapper_base {-| __C declaration:__ @f2@ __defined at:__ @functions\/decls_in_signature.h:20:6@ @@ -408,12 +460,19 @@ f2 :: Named_union -> IO Unit __exported by:__ @functions\/decls_in_signature.h@ -} f2 = \x_0 -> with x_0 (\y_1 -> f2_wrapper y_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3f49e28bee3f8746" hs_bindgen_3f49e28bee3f8746_base :: BaseForeignType (IO (FunPtr (Ptr Opaque -> + Ptr Outside -> + Outside -> + IO Unit))) +{-| __unique:__ @test_functionsdecls_in_signature_Example_get_normal_ptr@ +-} +hs_bindgen_3f49e28bee3f8746 :: IO (FunPtr (Ptr Opaque -> + Ptr Outside -> Outside -> IO Unit)) {-| __unique:__ @test_functionsdecls_in_signature_Example_get_normal_ptr@ -} -foreign import ccall safe "hs_bindgen_3f49e28bee3f8746" hs_bindgen_3f49e28bee3f8746 :: IO (FunPtr (Ptr Opaque -> - Ptr Outside -> - Outside -> - IO Unit)) +hs_bindgen_3f49e28bee3f8746 = fromBaseForeignType hs_bindgen_3f49e28bee3f8746_base {-# NOINLINE normal_ptr #-} {-| __C declaration:__ @normal@ @@ -430,10 +489,17 @@ normal_ptr :: FunPtr (Ptr Opaque -> __exported by:__ @functions\/decls_in_signature.h@ -} normal_ptr = unsafePerformIO hs_bindgen_3f49e28bee3f8746 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8de29d760cad0c00" hs_bindgen_8de29d760cad0c00_base :: BaseForeignType (IO (FunPtr (Named_struct -> + IO Unit))) {-| __unique:__ @test_functionsdecls_in_signature_Example_get_f1_ptr@ -} -foreign import ccall safe "hs_bindgen_8de29d760cad0c00" hs_bindgen_8de29d760cad0c00 :: IO (FunPtr (Named_struct -> - IO Unit)) +hs_bindgen_8de29d760cad0c00 :: IO (FunPtr (Named_struct -> + IO Unit)) +{-| __unique:__ @test_functionsdecls_in_signature_Example_get_f1_ptr@ +-} +hs_bindgen_8de29d760cad0c00 = fromBaseForeignType hs_bindgen_8de29d760cad0c00_base {-# NOINLINE f1_ptr #-} {-| Error cases @@ -457,10 +523,16 @@ __defined at:__ @functions\/decls_in_signature.h:17:6@ __exported by:__ @functions\/decls_in_signature.h@ -} f1_ptr = unsafePerformIO hs_bindgen_8de29d760cad0c00 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7a2b955aeef7fcd9" hs_bindgen_7a2b955aeef7fcd9_base :: BaseForeignType (IO (FunPtr (Named_union -> + IO Unit))) +{-| __unique:__ @test_functionsdecls_in_signature_Example_get_f2_ptr@ +-} +hs_bindgen_7a2b955aeef7fcd9 :: IO (FunPtr (Named_union -> IO Unit)) {-| __unique:__ @test_functionsdecls_in_signature_Example_get_f2_ptr@ -} -foreign import ccall safe "hs_bindgen_7a2b955aeef7fcd9" hs_bindgen_7a2b955aeef7fcd9 :: IO (FunPtr (Named_union -> - IO Unit)) +hs_bindgen_7a2b955aeef7fcd9 = fromBaseForeignType hs_bindgen_7a2b955aeef7fcd9_base {-# NOINLINE f2_ptr #-} {-| __C declaration:__ @f2@ diff --git a/hs-bindgen/fixtures/functions/fun_attributes/Example/FunPtr.hs b/hs-bindgen/fixtures/functions/fun_attributes/Example/FunPtr.hs index 6121618d0..a03bbc236 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/functions/fun_attributes/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) import Example @@ -190,10 +191,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_24a849cc3a4a1da5" hs_bindgen_24a849cc3a4a1da5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_functionsfun_attributes_Example_get___f1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_24a849cc3a4a1da5" hs_bindgen_24a849cc3a4a1da5 :: +hs_bindgen_24a849cc3a4a1da5 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_24a849cc3a4a1da5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_24a849cc3a4a1da5_base {-# NOINLINE __f1_ptr #-} @@ -207,10 +215,17 @@ __f1_ptr :: Ptr.FunPtr (IO ()) __f1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_24a849cc3a4a1da5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0e7d1a5941234285" hs_bindgen_0e7d1a5941234285_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_f1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_0e7d1a5941234285" hs_bindgen_0e7d1a5941234285 :: +hs_bindgen_0e7d1a5941234285 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_0e7d1a5941234285 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_0e7d1a5941234285_base {-# NOINLINE f1_ptr #-} @@ -224,10 +239,17 @@ f1_ptr :: Ptr.FunPtr (IO ()) f1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_0e7d1a5941234285 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_08646a1466ab9e1b" hs_bindgen_08646a1466ab9e1b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Size_t -> Size_t -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_my_memalign_ptr@ -} -foreign import ccall unsafe "hs_bindgen_08646a1466ab9e1b" hs_bindgen_08646a1466ab9e1b :: +hs_bindgen_08646a1466ab9e1b :: IO (Ptr.FunPtr (Size_t -> Size_t -> IO (Ptr.Ptr Void))) +hs_bindgen_08646a1466ab9e1b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_08646a1466ab9e1b_base {-# NOINLINE my_memalign_ptr #-} @@ -241,10 +263,17 @@ my_memalign_ptr :: Ptr.FunPtr (Size_t -> Size_t -> IO (Ptr.Ptr Void)) my_memalign_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_08646a1466ab9e1b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ed6d281e7bfe4523" hs_bindgen_ed6d281e7bfe4523_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Size_t -> Size_t -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_my_calloc_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ed6d281e7bfe4523" hs_bindgen_ed6d281e7bfe4523 :: +hs_bindgen_ed6d281e7bfe4523 :: IO (Ptr.FunPtr (Size_t -> Size_t -> IO (Ptr.Ptr Void))) +hs_bindgen_ed6d281e7bfe4523 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ed6d281e7bfe4523_base {-# NOINLINE my_calloc_ptr #-} @@ -258,10 +287,17 @@ my_calloc_ptr :: Ptr.FunPtr (Size_t -> Size_t -> IO (Ptr.Ptr Void)) my_calloc_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_ed6d281e7bfe4523 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_24c8bade35b40f21" hs_bindgen_24c8bade35b40f21_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Void) -> Size_t -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_my_realloc_ptr@ -} -foreign import ccall unsafe "hs_bindgen_24c8bade35b40f21" hs_bindgen_24c8bade35b40f21 :: +hs_bindgen_24c8bade35b40f21 :: IO (Ptr.FunPtr ((Ptr.Ptr Void) -> Size_t -> IO (Ptr.Ptr Void))) +hs_bindgen_24c8bade35b40f21 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_24c8bade35b40f21_base {-# NOINLINE my_realloc_ptr #-} @@ -275,10 +311,17 @@ my_realloc_ptr :: Ptr.FunPtr ((Ptr.Ptr Void) -> Size_t -> IO (Ptr.Ptr Void)) my_realloc_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_24c8bade35b40f21 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_930dccd393b8f937" hs_bindgen_930dccd393b8f937_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Size_t -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_my_alloc1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_930dccd393b8f937" hs_bindgen_930dccd393b8f937 :: +hs_bindgen_930dccd393b8f937 :: IO (Ptr.FunPtr (Size_t -> IO (Ptr.Ptr Void))) +hs_bindgen_930dccd393b8f937 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_930dccd393b8f937_base {-# NOINLINE my_alloc1_ptr #-} @@ -292,10 +335,17 @@ my_alloc1_ptr :: Ptr.FunPtr (Size_t -> IO (Ptr.Ptr Void)) my_alloc1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_930dccd393b8f937 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b15d8039514faa44" hs_bindgen_b15d8039514faa44_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Size_t -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_my_alloc2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b15d8039514faa44" hs_bindgen_b15d8039514faa44 :: +hs_bindgen_b15d8039514faa44 :: IO (Ptr.FunPtr (Size_t -> IO (Ptr.Ptr Void))) +hs_bindgen_b15d8039514faa44 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b15d8039514faa44_base {-# NOINLINE my_alloc2_ptr #-} @@ -309,10 +359,17 @@ my_alloc2_ptr :: Ptr.FunPtr (Size_t -> IO (Ptr.Ptr Void)) my_alloc2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_b15d8039514faa44 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9a26c4f7828e9f21" hs_bindgen_9a26c4f7828e9f21_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_square_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9a26c4f7828e9f21" hs_bindgen_9a26c4f7828e9f21 :: +hs_bindgen_9a26c4f7828e9f21 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_9a26c4f7828e9f21 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9a26c4f7828e9f21_base {-# NOINLINE square_ptr #-} @@ -326,10 +383,17 @@ square_ptr :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) square_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9a26c4f7828e9f21 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_75b7d9140b40148e" hs_bindgen_75b7d9140b40148e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_old_fn_deprecated_ptr@ -} -foreign import ccall unsafe "hs_bindgen_75b7d9140b40148e" hs_bindgen_75b7d9140b40148e :: +hs_bindgen_75b7d9140b40148e :: IO (Ptr.FunPtr (IO FC.CInt)) +hs_bindgen_75b7d9140b40148e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_75b7d9140b40148e_base {-# NOINLINE old_fn_deprecated_ptr #-} @@ -343,10 +407,17 @@ old_fn_deprecated_ptr :: Ptr.FunPtr (IO FC.CInt) old_fn_deprecated_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_75b7d9140b40148e +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_880fe66e7b0bf3df" hs_bindgen_880fe66e7b0bf3df_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> (Ptr.Ptr FC.CChar) -> IO (Ptr.Ptr FC.CChar)))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_my_dgettext_ptr@ -} -foreign import ccall unsafe "hs_bindgen_880fe66e7b0bf3df" hs_bindgen_880fe66e7b0bf3df :: +hs_bindgen_880fe66e7b0bf3df :: IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> (Ptr.Ptr FC.CChar) -> IO (Ptr.Ptr FC.CChar))) +hs_bindgen_880fe66e7b0bf3df = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_880fe66e7b0bf3df_base {-# NOINLINE my_dgettext_ptr #-} @@ -360,10 +431,17 @@ my_dgettext_ptr :: Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> (Ptr.Ptr FC.CChar) -> IO (P my_dgettext_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_880fe66e7b0bf3df +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e36b210e874d5d42" hs_bindgen_e36b210e874d5d42_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> (Ptr.Ptr FC.CChar) -> IO (Ptr.Ptr FILE)))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_fdopen_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e36b210e874d5d42" hs_bindgen_e36b210e874d5d42 :: +hs_bindgen_e36b210e874d5d42 :: IO (Ptr.FunPtr (FC.CInt -> (Ptr.Ptr FC.CChar) -> IO (Ptr.Ptr FILE))) +hs_bindgen_e36b210e874d5d42 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e36b210e874d5d42_base {-# NOINLINE fdopen_ptr #-} @@ -377,10 +455,17 @@ fdopen_ptr :: Ptr.FunPtr (FC.CInt -> (Ptr.Ptr FC.CChar) -> IO (Ptr.Ptr FILE)) fdopen_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e36b210e874d5d42 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_193dba4a732d39a4" hs_bindgen_193dba4a732d39a4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_f2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_193dba4a732d39a4" hs_bindgen_193dba4a732d39a4 :: +hs_bindgen_193dba4a732d39a4 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_193dba4a732d39a4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_193dba4a732d39a4_base {-# NOINLINE f2_ptr #-} @@ -394,10 +479,17 @@ f2_ptr :: Ptr.FunPtr (IO ()) f2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_193dba4a732d39a4 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_95f5193f59c47586" hs_bindgen_95f5193f59c47586_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> Size_t -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_my_memcpy_ptr@ -} -foreign import ccall unsafe "hs_bindgen_95f5193f59c47586" hs_bindgen_95f5193f59c47586 :: +hs_bindgen_95f5193f59c47586 :: IO (Ptr.FunPtr ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> Size_t -> IO (Ptr.Ptr Void))) +hs_bindgen_95f5193f59c47586 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_95f5193f59c47586_base {-# NOINLINE my_memcpy_ptr #-} @@ -411,10 +503,17 @@ my_memcpy_ptr :: Ptr.FunPtr ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> Size_t -> IO (P my_memcpy_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_95f5193f59c47586 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6944ffce3b5c6e81" hs_bindgen_6944ffce3b5c6e81_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_fatal_ptr@ -} -foreign import ccall unsafe "hs_bindgen_6944ffce3b5c6e81" hs_bindgen_6944ffce3b5c6e81 :: +hs_bindgen_6944ffce3b5c6e81 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_6944ffce3b5c6e81 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_6944ffce3b5c6e81_base {-# NOINLINE fatal_ptr #-} @@ -428,10 +527,17 @@ fatal_ptr :: Ptr.FunPtr (IO ()) fatal_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_6944ffce3b5c6e81 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_71a42f1d6c853302" hs_bindgen_71a42f1d6c853302_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_hash_ptr@ -} -foreign import ccall unsafe "hs_bindgen_71a42f1d6c853302" hs_bindgen_71a42f1d6c853302 :: +hs_bindgen_71a42f1d6c853302 :: IO (Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CInt)) +hs_bindgen_71a42f1d6c853302 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_71a42f1d6c853302_base {-# NOINLINE hash_ptr #-} @@ -445,10 +551,17 @@ hash_ptr :: Ptr.FunPtr ((Ptr.Ptr FC.CChar) -> IO FC.CInt) hash_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_71a42f1d6c853302 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_97fdda2d31fdf3b8" hs_bindgen_97fdda2d31fdf3b8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Size_t -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_mymalloc_ptr@ -} -foreign import ccall unsafe "hs_bindgen_97fdda2d31fdf3b8" hs_bindgen_97fdda2d31fdf3b8 :: +hs_bindgen_97fdda2d31fdf3b8 :: IO (Ptr.FunPtr (Size_t -> IO (Ptr.Ptr Void))) +hs_bindgen_97fdda2d31fdf3b8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_97fdda2d31fdf3b8_base {-# NOINLINE mymalloc_ptr #-} @@ -462,10 +575,17 @@ mymalloc_ptr :: Ptr.FunPtr (Size_t -> IO (Ptr.Ptr Void)) mymalloc_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_97fdda2d31fdf3b8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f8e2e1e043022d0b" hs_bindgen_f8e2e1e043022d0b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_foobar_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f8e2e1e043022d0b" hs_bindgen_f8e2e1e043022d0b :: +hs_bindgen_f8e2e1e043022d0b :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_f8e2e1e043022d0b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f8e2e1e043022d0b_base {-# NOINLINE foobar_ptr #-} @@ -479,10 +599,17 @@ foobar_ptr :: Ptr.FunPtr (IO ()) foobar_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f8e2e1e043022d0b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c0d2203c2008c671" hs_bindgen_c0d2203c2008c671_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_core2_func_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c0d2203c2008c671" hs_bindgen_c0d2203c2008c671 :: +hs_bindgen_c0d2203c2008c671 :: IO (Ptr.FunPtr (IO FC.CInt)) +hs_bindgen_c0d2203c2008c671 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c0d2203c2008c671_base {-# NOINLINE core2_func_ptr #-} @@ -496,10 +623,17 @@ core2_func_ptr :: Ptr.FunPtr (IO FC.CInt) core2_func_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c0d2203c2008c671 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0d9e6d9c675bc6c6" hs_bindgen_0d9e6d9c675bc6c6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_sse3_func_ptr@ -} -foreign import ccall unsafe "hs_bindgen_0d9e6d9c675bc6c6" hs_bindgen_0d9e6d9c675bc6c6 :: +hs_bindgen_0d9e6d9c675bc6c6 :: IO (Ptr.FunPtr (IO FC.CInt)) +hs_bindgen_0d9e6d9c675bc6c6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_0d9e6d9c675bc6c6_base {-# NOINLINE sse3_func_ptr #-} @@ -513,10 +647,17 @@ sse3_func_ptr :: Ptr.FunPtr (IO FC.CInt) sse3_func_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_0d9e6d9c675bc6c6 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_83d5762c52905621" hs_bindgen_83d5762c52905621_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_f3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_83d5762c52905621" hs_bindgen_83d5762c52905621 :: +hs_bindgen_83d5762c52905621 :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_83d5762c52905621 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_83d5762c52905621_base {-# NOINLINE f3_ptr #-} @@ -530,10 +671,17 @@ f3_ptr :: Ptr.FunPtr (IO ()) f3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_83d5762c52905621 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2c761cc9b4f8156d" hs_bindgen_2c761cc9b4f8156d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_fn_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2c761cc9b4f8156d" hs_bindgen_2c761cc9b4f8156d :: +hs_bindgen_2c761cc9b4f8156d :: IO (Ptr.FunPtr (IO FC.CInt)) +hs_bindgen_2c761cc9b4f8156d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2c761cc9b4f8156d_base {-# NOINLINE fn_ptr #-} @@ -547,10 +695,17 @@ fn_ptr :: Ptr.FunPtr (IO FC.CInt) fn_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2c761cc9b4f8156d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a1175242bc62c1a1" hs_bindgen_a1175242bc62c1a1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_y_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a1175242bc62c1a1" hs_bindgen_a1175242bc62c1a1 :: +hs_bindgen_a1175242bc62c1a1 :: IO (Ptr.FunPtr (IO FC.CInt)) +hs_bindgen_a1175242bc62c1a1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a1175242bc62c1a1_base {-# NOINLINE y_ptr #-} @@ -564,10 +719,17 @@ y_ptr :: Ptr.FunPtr (IO FC.CInt) y_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a1175242bc62c1a1 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9ccc986739d1a164" hs_bindgen_9ccc986739d1a164_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_x1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9ccc986739d1a164" hs_bindgen_9ccc986739d1a164 :: +hs_bindgen_9ccc986739d1a164 :: IO (Ptr.FunPtr (IO FC.CInt)) +hs_bindgen_9ccc986739d1a164 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9ccc986739d1a164_base {-# NOINLINE x1_ptr #-} @@ -581,10 +743,17 @@ x1_ptr :: Ptr.FunPtr (IO FC.CInt) x1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9ccc986739d1a164 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8f44934a5928d386" hs_bindgen_8f44934a5928d386_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_Example_get_x2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8f44934a5928d386" hs_bindgen_8f44934a5928d386 :: +hs_bindgen_8f44934a5928d386 :: IO (Ptr.FunPtr (IO FC.CInt)) +hs_bindgen_8f44934a5928d386 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8f44934a5928d386_base {-# NOINLINE x2_ptr #-} diff --git a/hs-bindgen/fixtures/functions/fun_attributes/Example/Global.hs b/hs-bindgen/fixtures/functions/fun_attributes/Example/Global.hs index d3f1c516b..48961e72c 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes/Example/Global.hs +++ b/hs-bindgen/fixtures/functions/fun_attributes/Example/Global.hs @@ -8,6 +8,7 @@ module Example.Global where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -21,10 +22,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ea890ba2b1b3e0a8" hs_bindgen_ea890ba2b1b3e0a8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_functionsfun_attributes_Example_get_i_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ea890ba2b1b3e0a8" hs_bindgen_ea890ba2b1b3e0a8 :: +hs_bindgen_ea890ba2b1b3e0a8 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_ea890ba2b1b3e0a8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ea890ba2b1b3e0a8_base {-# NOINLINE i_ptr #-} diff --git a/hs-bindgen/fixtures/functions/fun_attributes/Example/Safe.hs b/hs-bindgen/fixtures/functions/fun_attributes/Example/Safe.hs index 4a6412cce..c5bbb2107 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes/Example/Safe.hs +++ b/hs-bindgen/fixtures/functions/fun_attributes/Example/Safe.hs @@ -7,6 +7,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) import Example @@ -141,6 +142,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0560fe42a40f777f" __f1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @__f1@ __defined at:__ @functions\/fun_attributes.h:16:13@ @@ -149,8 +155,15 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_functionsfun_attributes_Example_Safe___f1@ -} -foreign import ccall safe "hs_bindgen_0560fe42a40f777f" __f1 :: +__f1 :: IO () +__f1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType __f1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1a4676387075dc40" f1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f1@ @@ -160,8 +173,15 @@ foreign import ccall safe "hs_bindgen_0560fe42a40f777f" __f1 :: __unique:__ @test_functionsfun_attributes_Example_Safe_f1@ -} -foreign import ccall safe "hs_bindgen_1a4676387075dc40" f1 :: +f1 :: IO () +f1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_63adcb061045c5ac" my_memalign_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_memalign@ @@ -171,10 +191,17 @@ foreign import ccall safe "hs_bindgen_1a4676387075dc40" f1 :: __unique:__ @test_functionsfun_attributes_Example_Safe_my_memalign@ -} -foreign import ccall safe "hs_bindgen_63adcb061045c5ac" my_memalign :: +my_memalign :: Size_t -> Size_t -> IO (Ptr.Ptr Void) +my_memalign = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_memalign_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_733b29547ce864f6" my_calloc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_calloc@ @@ -184,10 +211,17 @@ foreign import ccall safe "hs_bindgen_63adcb061045c5ac" my_memalign :: __unique:__ @test_functionsfun_attributes_Example_Safe_my_calloc@ -} -foreign import ccall safe "hs_bindgen_733b29547ce864f6" my_calloc :: +my_calloc :: Size_t -> Size_t -> IO (Ptr.Ptr Void) +my_calloc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_calloc_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4c69efa2a8a2b7c0" my_realloc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Void) -> Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_realloc@ @@ -197,10 +231,17 @@ foreign import ccall safe "hs_bindgen_733b29547ce864f6" my_calloc :: __unique:__ @test_functionsfun_attributes_Example_Safe_my_realloc@ -} -foreign import ccall safe "hs_bindgen_4c69efa2a8a2b7c0" my_realloc :: +my_realloc :: Ptr.Ptr Void -> Size_t -> IO (Ptr.Ptr Void) +my_realloc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_realloc_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1eae846583dd415c" my_alloc1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_alloc1@ @@ -210,9 +251,16 @@ foreign import ccall safe "hs_bindgen_4c69efa2a8a2b7c0" my_realloc :: __unique:__ @test_functionsfun_attributes_Example_Safe_my_alloc1@ -} -foreign import ccall safe "hs_bindgen_1eae846583dd415c" my_alloc1 :: +my_alloc1 :: Size_t -> IO (Ptr.Ptr Void) +my_alloc1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_alloc1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_790482b4016de326" my_alloc2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_alloc2@ @@ -222,9 +270,16 @@ foreign import ccall safe "hs_bindgen_1eae846583dd415c" my_alloc1 :: __unique:__ @test_functionsfun_attributes_Example_Safe_my_alloc2@ -} -foreign import ccall safe "hs_bindgen_790482b4016de326" my_alloc2 :: +my_alloc2 :: Size_t -> IO (Ptr.Ptr Void) +my_alloc2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_alloc2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3f72dedf649beccd" square_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) {-| __C declaration:__ @square@ @@ -234,9 +289,16 @@ foreign import ccall safe "hs_bindgen_790482b4016de326" my_alloc2 :: __unique:__ @test_functionsfun_attributes_Example_Safe_square@ -} -foreign import ccall safe "hs_bindgen_3f72dedf649beccd" square :: +square :: FC.CInt -> FC.CInt +square = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a8f71f2272dae572" old_fn_deprecated_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @old_fn_deprecated@ @@ -246,8 +308,15 @@ foreign import ccall safe "hs_bindgen_3f72dedf649beccd" square :: __unique:__ @test_functionsfun_attributes_Example_Safe_old_fn_deprecated@ -} -foreign import ccall safe "hs_bindgen_a8f71f2272dae572" old_fn_deprecated :: +old_fn_deprecated :: IO FC.CInt +old_fn_deprecated = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType old_fn_deprecated_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_11a623401451cca5" my_dgettext_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> (Ptr.Ptr FC.CChar) -> IO (Ptr.Ptr FC.CChar)) {-| __C declaration:__ @my_dgettext@ @@ -257,7 +326,7 @@ foreign import ccall safe "hs_bindgen_a8f71f2272dae572" old_fn_deprecated :: __unique:__ @test_functionsfun_attributes_Example_Safe_my_dgettext@ -} -foreign import ccall safe "hs_bindgen_11a623401451cca5" my_dgettext :: +my_dgettext :: Ptr.Ptr FC.CChar {- ^ __C declaration:__ @my_domain@ -} @@ -265,6 +334,13 @@ foreign import ccall safe "hs_bindgen_11a623401451cca5" my_dgettext :: {- ^ __C declaration:__ @my_format@ -} -> IO (Ptr.Ptr FC.CChar) +my_dgettext = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_dgettext_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_30143e337a327ef0" fdopen_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr FC.CChar) -> IO (Ptr.Ptr FILE)) {-| __C declaration:__ @fdopen@ @@ -274,10 +350,17 @@ foreign import ccall safe "hs_bindgen_11a623401451cca5" my_dgettext :: __unique:__ @test_functionsfun_attributes_Example_Safe_fdopen@ -} -foreign import ccall safe "hs_bindgen_30143e337a327ef0" fdopen :: +fdopen :: FC.CInt -> Ptr.Ptr FC.CChar -> IO (Ptr.Ptr FILE) +fdopen = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fdopen_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7b2c420d0febf062" f2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f2@ @@ -287,8 +370,15 @@ foreign import ccall safe "hs_bindgen_30143e337a327ef0" fdopen :: __unique:__ @test_functionsfun_attributes_Example_Safe_f2@ -} -foreign import ccall safe "hs_bindgen_7b2c420d0febf062" f2 :: +f2 :: IO () +f2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_af1f131d9e98a2ff" my_memcpy_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_memcpy@ @@ -298,7 +388,7 @@ foreign import ccall safe "hs_bindgen_7b2c420d0febf062" f2 :: __unique:__ @test_functionsfun_attributes_Example_Safe_my_memcpy@ -} -foreign import ccall safe "hs_bindgen_af1f131d9e98a2ff" my_memcpy :: +my_memcpy :: Ptr.Ptr Void {- ^ __C declaration:__ @dest@ -} @@ -309,6 +399,13 @@ foreign import ccall safe "hs_bindgen_af1f131d9e98a2ff" my_memcpy :: {- ^ __C declaration:__ @len@ -} -> IO (Ptr.Ptr Void) +my_memcpy = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_memcpy_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0afa6ff8226517c8" fatal_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @fatal@ @@ -318,8 +415,15 @@ foreign import ccall safe "hs_bindgen_af1f131d9e98a2ff" my_memcpy :: __unique:__ @test_functionsfun_attributes_Example_Safe_fatal@ -} -foreign import ccall safe "hs_bindgen_0afa6ff8226517c8" fatal :: +fatal :: IO () +fatal = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fatal_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_948fc14ee9d5d56f" hash_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> IO FC.CInt) {-| @@ -333,9 +437,16 @@ __exported by:__ @functions\/fun_attributes.h@ __unique:__ @test_functionsfun_attributes_Example_Safe_hash@ -} -foreign import ccall safe "hs_bindgen_948fc14ee9d5d56f" hash :: +hash :: Ptr.Ptr FC.CChar -> IO FC.CInt +hash = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hash_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_60517fb6ae2517ff" mymalloc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @mymalloc@ @@ -345,11 +456,18 @@ foreign import ccall safe "hs_bindgen_948fc14ee9d5d56f" hash :: __unique:__ @test_functionsfun_attributes_Example_Safe_mymalloc@ -} -foreign import ccall safe "hs_bindgen_60517fb6ae2517ff" mymalloc :: +mymalloc :: Size_t {- ^ __C declaration:__ @len@ -} -> IO (Ptr.Ptr Void) +mymalloc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType mymalloc_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f1451b46f1bd3813" foobar_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @foobar@ @@ -359,8 +477,15 @@ foreign import ccall safe "hs_bindgen_60517fb6ae2517ff" mymalloc :: __unique:__ @test_functionsfun_attributes_Example_Safe_foobar@ -} -foreign import ccall safe "hs_bindgen_f1451b46f1bd3813" foobar :: +foobar :: IO () +foobar = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foobar_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_07f5843dd5c65611" core2_func_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @core2_func@ @@ -370,8 +495,15 @@ foreign import ccall safe "hs_bindgen_f1451b46f1bd3813" foobar :: __unique:__ @test_functionsfun_attributes_Example_Safe_core2_func@ -} -foreign import ccall safe "hs_bindgen_07f5843dd5c65611" core2_func :: +core2_func :: IO FC.CInt +core2_func = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType core2_func_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2c7c9e9a45042696" sse3_func_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @sse3_func@ @@ -381,8 +513,15 @@ foreign import ccall safe "hs_bindgen_07f5843dd5c65611" core2_func :: __unique:__ @test_functionsfun_attributes_Example_Safe_sse3_func@ -} -foreign import ccall safe "hs_bindgen_2c7c9e9a45042696" sse3_func :: +sse3_func :: IO FC.CInt +sse3_func = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType sse3_func_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4ff2d7abd6099082" f3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f3@ @@ -392,8 +531,15 @@ foreign import ccall safe "hs_bindgen_2c7c9e9a45042696" sse3_func :: __unique:__ @test_functionsfun_attributes_Example_Safe_f3@ -} -foreign import ccall safe "hs_bindgen_4ff2d7abd6099082" f3 :: +f3 :: IO () +f3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c3ae037518ec9b4e" fn_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @fn@ @@ -403,8 +549,15 @@ foreign import ccall safe "hs_bindgen_4ff2d7abd6099082" f3 :: __unique:__ @test_functionsfun_attributes_Example_Safe_fn@ -} -foreign import ccall safe "hs_bindgen_c3ae037518ec9b4e" fn :: +fn :: IO FC.CInt +fn = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fn_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_da9708096863a242" y_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @y@ @@ -414,8 +567,15 @@ foreign import ccall safe "hs_bindgen_c3ae037518ec9b4e" fn :: __unique:__ @test_functionsfun_attributes_Example_Safe_y@ -} -foreign import ccall safe "hs_bindgen_da9708096863a242" y :: +y :: IO FC.CInt +y = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType y_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_037c35609f7728b3" x1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @x1@ @@ -425,8 +585,15 @@ foreign import ccall safe "hs_bindgen_da9708096863a242" y :: __unique:__ @test_functionsfun_attributes_Example_Safe_x1@ -} -foreign import ccall safe "hs_bindgen_037c35609f7728b3" x1 :: +x1 :: IO FC.CInt +x1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType x1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2c3e8d78049741c3" x2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @x2@ @@ -436,5 +603,7 @@ foreign import ccall safe "hs_bindgen_037c35609f7728b3" x1 :: __unique:__ @test_functionsfun_attributes_Example_Safe_x2@ -} -foreign import ccall safe "hs_bindgen_2c3e8d78049741c3" x2 :: +x2 :: IO FC.CInt +x2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType x2_base diff --git a/hs-bindgen/fixtures/functions/fun_attributes/Example/Unsafe.hs b/hs-bindgen/fixtures/functions/fun_attributes/Example/Unsafe.hs index df8c24fa6..6702d59de 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/functions/fun_attributes/Example/Unsafe.hs @@ -7,6 +7,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) import Example @@ -141,6 +142,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_52759f125bf2b140" __f1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @__f1@ __defined at:__ @functions\/fun_attributes.h:16:13@ @@ -149,8 +155,15 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_functionsfun_attributes_Example_Unsafe___f1@ -} -foreign import ccall unsafe "hs_bindgen_52759f125bf2b140" __f1 :: +__f1 :: IO () +__f1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType __f1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_80bb9d1445e894ca" f1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f1@ @@ -160,8 +173,15 @@ foreign import ccall unsafe "hs_bindgen_52759f125bf2b140" __f1 :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_f1@ -} -foreign import ccall unsafe "hs_bindgen_80bb9d1445e894ca" f1 :: +f1 :: IO () +f1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ebf8d1f009064640" my_memalign_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_memalign@ @@ -171,10 +191,17 @@ foreign import ccall unsafe "hs_bindgen_80bb9d1445e894ca" f1 :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memalign@ -} -foreign import ccall unsafe "hs_bindgen_ebf8d1f009064640" my_memalign :: +my_memalign :: Size_t -> Size_t -> IO (Ptr.Ptr Void) +my_memalign = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_memalign_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a062d8e757dc6824" my_calloc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_calloc@ @@ -184,10 +211,17 @@ foreign import ccall unsafe "hs_bindgen_ebf8d1f009064640" my_memalign :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_calloc@ -} -foreign import ccall unsafe "hs_bindgen_a062d8e757dc6824" my_calloc :: +my_calloc :: Size_t -> Size_t -> IO (Ptr.Ptr Void) +my_calloc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_calloc_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_899561850b80c305" my_realloc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Void) -> Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_realloc@ @@ -197,10 +231,17 @@ foreign import ccall unsafe "hs_bindgen_a062d8e757dc6824" my_calloc :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_realloc@ -} -foreign import ccall unsafe "hs_bindgen_899561850b80c305" my_realloc :: +my_realloc :: Ptr.Ptr Void -> Size_t -> IO (Ptr.Ptr Void) +my_realloc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_realloc_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d5eb45f9de991bca" my_alloc1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_alloc1@ @@ -210,9 +251,16 @@ foreign import ccall unsafe "hs_bindgen_899561850b80c305" my_realloc :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc1@ -} -foreign import ccall unsafe "hs_bindgen_d5eb45f9de991bca" my_alloc1 :: +my_alloc1 :: Size_t -> IO (Ptr.Ptr Void) +my_alloc1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_alloc1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a7aa3949fa7cae3f" my_alloc2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_alloc2@ @@ -222,9 +270,16 @@ foreign import ccall unsafe "hs_bindgen_d5eb45f9de991bca" my_alloc1 :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc2@ -} -foreign import ccall unsafe "hs_bindgen_a7aa3949fa7cae3f" my_alloc2 :: +my_alloc2 :: Size_t -> IO (Ptr.Ptr Void) +my_alloc2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_alloc2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dbe49279b6585cea" square_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) {-| __C declaration:__ @square@ @@ -234,9 +289,16 @@ foreign import ccall unsafe "hs_bindgen_a7aa3949fa7cae3f" my_alloc2 :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_square@ -} -foreign import ccall unsafe "hs_bindgen_dbe49279b6585cea" square :: +square :: FC.CInt -> FC.CInt +square = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f51c36dd7e8f4133" old_fn_deprecated_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @old_fn_deprecated@ @@ -246,8 +308,15 @@ foreign import ccall unsafe "hs_bindgen_dbe49279b6585cea" square :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_old_fn_deprecated@ -} -foreign import ccall unsafe "hs_bindgen_f51c36dd7e8f4133" old_fn_deprecated :: +old_fn_deprecated :: IO FC.CInt +old_fn_deprecated = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType old_fn_deprecated_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bf6f222178bd7c31" my_dgettext_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> (Ptr.Ptr FC.CChar) -> IO (Ptr.Ptr FC.CChar)) {-| __C declaration:__ @my_dgettext@ @@ -257,7 +326,7 @@ foreign import ccall unsafe "hs_bindgen_f51c36dd7e8f4133" old_fn_deprecated :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_dgettext@ -} -foreign import ccall unsafe "hs_bindgen_bf6f222178bd7c31" my_dgettext :: +my_dgettext :: Ptr.Ptr FC.CChar {- ^ __C declaration:__ @my_domain@ -} @@ -265,6 +334,13 @@ foreign import ccall unsafe "hs_bindgen_bf6f222178bd7c31" my_dgettext :: {- ^ __C declaration:__ @my_format@ -} -> IO (Ptr.Ptr FC.CChar) +my_dgettext = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_dgettext_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_830629dc11c2fdfc" fdopen_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr FC.CChar) -> IO (Ptr.Ptr FILE)) {-| __C declaration:__ @fdopen@ @@ -274,10 +350,17 @@ foreign import ccall unsafe "hs_bindgen_bf6f222178bd7c31" my_dgettext :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_fdopen@ -} -foreign import ccall unsafe "hs_bindgen_830629dc11c2fdfc" fdopen :: +fdopen :: FC.CInt -> Ptr.Ptr FC.CChar -> IO (Ptr.Ptr FILE) +fdopen = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fdopen_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a5f34f5beb1c74f1" f2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f2@ @@ -287,8 +370,15 @@ foreign import ccall unsafe "hs_bindgen_830629dc11c2fdfc" fdopen :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_f2@ -} -foreign import ccall unsafe "hs_bindgen_a5f34f5beb1c74f1" f2 :: +f2 :: IO () +f2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0f3586df383dffea" my_memcpy_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Void) -> (Ptr.Ptr Void) -> Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @my_memcpy@ @@ -298,7 +388,7 @@ foreign import ccall unsafe "hs_bindgen_a5f34f5beb1c74f1" f2 :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memcpy@ -} -foreign import ccall unsafe "hs_bindgen_0f3586df383dffea" my_memcpy :: +my_memcpy :: Ptr.Ptr Void {- ^ __C declaration:__ @dest@ -} @@ -309,6 +399,13 @@ foreign import ccall unsafe "hs_bindgen_0f3586df383dffea" my_memcpy :: {- ^ __C declaration:__ @len@ -} -> IO (Ptr.Ptr Void) +my_memcpy = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType my_memcpy_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_667d3280d945cd0c" fatal_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @fatal@ @@ -318,8 +415,15 @@ foreign import ccall unsafe "hs_bindgen_0f3586df383dffea" my_memcpy :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_fatal@ -} -foreign import ccall unsafe "hs_bindgen_667d3280d945cd0c" fatal :: +fatal :: IO () +fatal = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fatal_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_394fd662d5fb7aa6" hash_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr FC.CChar) -> IO FC.CInt) {-| @@ -333,9 +437,16 @@ __exported by:__ @functions\/fun_attributes.h@ __unique:__ @test_functionsfun_attributes_Example_Unsafe_hash@ -} -foreign import ccall unsafe "hs_bindgen_394fd662d5fb7aa6" hash :: +hash :: Ptr.Ptr FC.CChar -> IO FC.CInt +hash = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hash_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5594a84fb65782e1" mymalloc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (Size_t -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @mymalloc@ @@ -345,11 +456,18 @@ foreign import ccall unsafe "hs_bindgen_394fd662d5fb7aa6" hash :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_mymalloc@ -} -foreign import ccall unsafe "hs_bindgen_5594a84fb65782e1" mymalloc :: +mymalloc :: Size_t {- ^ __C declaration:__ @len@ -} -> IO (Ptr.Ptr Void) +mymalloc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType mymalloc_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1f19397195b32853" foobar_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @foobar@ @@ -359,8 +477,15 @@ foreign import ccall unsafe "hs_bindgen_5594a84fb65782e1" mymalloc :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_foobar@ -} -foreign import ccall unsafe "hs_bindgen_1f19397195b32853" foobar :: +foobar :: IO () +foobar = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foobar_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f80f9b58791a9cf2" core2_func_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @core2_func@ @@ -370,8 +495,15 @@ foreign import ccall unsafe "hs_bindgen_1f19397195b32853" foobar :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_core2_func@ -} -foreign import ccall unsafe "hs_bindgen_f80f9b58791a9cf2" core2_func :: +core2_func :: IO FC.CInt +core2_func = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType core2_func_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6a951361c18a91a0" sse3_func_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @sse3_func@ @@ -381,8 +513,15 @@ foreign import ccall unsafe "hs_bindgen_f80f9b58791a9cf2" core2_func :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_sse3_func@ -} -foreign import ccall unsafe "hs_bindgen_6a951361c18a91a0" sse3_func :: +sse3_func :: IO FC.CInt +sse3_func = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType sse3_func_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1d7f2cdf95b3bfa3" f3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @f3@ @@ -392,8 +531,15 @@ foreign import ccall unsafe "hs_bindgen_6a951361c18a91a0" sse3_func :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_f3@ -} -foreign import ccall unsafe "hs_bindgen_1d7f2cdf95b3bfa3" f3 :: +f3 :: IO () +f3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType f3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c1fff017165ba0e1" fn_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @fn@ @@ -403,8 +549,15 @@ foreign import ccall unsafe "hs_bindgen_1d7f2cdf95b3bfa3" f3 :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_fn@ -} -foreign import ccall unsafe "hs_bindgen_c1fff017165ba0e1" fn :: +fn :: IO FC.CInt +fn = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fn_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_67dc9f91fbda20c7" y_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @y@ @@ -414,8 +567,15 @@ foreign import ccall unsafe "hs_bindgen_c1fff017165ba0e1" fn :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_y@ -} -foreign import ccall unsafe "hs_bindgen_67dc9f91fbda20c7" y :: +y :: IO FC.CInt +y = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType y_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8562db8b96c10d6b" x1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @x1@ @@ -425,8 +585,15 @@ foreign import ccall unsafe "hs_bindgen_67dc9f91fbda20c7" y :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_x1@ -} -foreign import ccall unsafe "hs_bindgen_8562db8b96c10d6b" x1 :: +x1 :: IO FC.CInt +x1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType x1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_150a79fec58eaf56" x2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO FC.CInt) {-| __C declaration:__ @x2@ @@ -436,5 +603,7 @@ foreign import ccall unsafe "hs_bindgen_8562db8b96c10d6b" x1 :: __unique:__ @test_functionsfun_attributes_Example_Unsafe_x2@ -} -foreign import ccall unsafe "hs_bindgen_150a79fec58eaf56" x2 :: +x2 :: IO FC.CInt +x2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType x2_base diff --git a/hs-bindgen/fixtures/functions/fun_attributes/th.txt b/hs-bindgen/fixtures/functions/fun_attributes/th.txt index 890412bec..486632d1f 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes/th.txt +++ b/hs-bindgen/fixtures/functions/fun_attributes/th.txt @@ -485,6 +485,18 @@ instance TyEq ty (CFieldType Size_t "un_Size_t") => instance HasCField Size_t "un_Size_t" where type CFieldType Size_t "un_Size_t" = CInt offset# = \_ -> \_ -> 0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0560fe42a40f777f" __f1_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @__f1@ + + __defined at:__ @functions\/fun_attributes.h:16:13@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe___f1@ +-} +__f1 :: IO Unit {-| __C declaration:__ @__f1@ __defined at:__ @functions\/fun_attributes.h:16:13@ @@ -493,7 +505,19 @@ instance HasCField Size_t "un_Size_t" __unique:__ @test_functionsfun_attributes_Example_Unsafe___f1@ -} -foreign import ccall safe "hs_bindgen_0560fe42a40f777f" __f1 :: IO Unit +__f1 = fromBaseForeignType __f1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1a4676387075dc40" f1_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f1@ + + __defined at:__ @functions\/fun_attributes.h:19:6@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_f1@ +-} +f1 :: IO Unit {-| __C declaration:__ @f1@ __defined at:__ @functions\/fun_attributes.h:19:6@ @@ -502,7 +526,12 @@ foreign import ccall safe "hs_bindgen_0560fe42a40f777f" __f1 :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_f1@ -} -foreign import ccall safe "hs_bindgen_1a4676387075dc40" f1 :: IO Unit +f1 = fromBaseForeignType f1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_63adcb061045c5ac" my_memalign_base :: BaseForeignType (Size_t -> + Size_t -> + IO (Ptr Void)) {-| __C declaration:__ @my_memalign@ __defined at:__ @functions\/fun_attributes.h:23:7@ @@ -511,8 +540,21 @@ foreign import ccall safe "hs_bindgen_1a4676387075dc40" f1 :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memalign@ -} -foreign import ccall safe "hs_bindgen_63adcb061045c5ac" my_memalign :: Size_t -> - Size_t -> IO (Ptr Void) +my_memalign :: Size_t -> Size_t -> IO (Ptr Void) +{-| __C declaration:__ @my_memalign@ + + __defined at:__ @functions\/fun_attributes.h:23:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memalign@ +-} +my_memalign = fromBaseForeignType my_memalign_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_733b29547ce864f6" my_calloc_base :: BaseForeignType (Size_t -> + Size_t -> + IO (Ptr Void)) {-| __C declaration:__ @my_calloc@ __defined at:__ @functions\/fun_attributes.h:28:7@ @@ -521,8 +563,21 @@ foreign import ccall safe "hs_bindgen_63adcb061045c5ac" my_memalign :: Size_t -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_calloc@ -} -foreign import ccall safe "hs_bindgen_733b29547ce864f6" my_calloc :: Size_t -> - Size_t -> IO (Ptr Void) +my_calloc :: Size_t -> Size_t -> IO (Ptr Void) +{-| __C declaration:__ @my_calloc@ + + __defined at:__ @functions\/fun_attributes.h:28:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_calloc@ +-} +my_calloc = fromBaseForeignType my_calloc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4c69efa2a8a2b7c0" my_realloc_base :: BaseForeignType (Ptr Void -> + Size_t -> + IO (Ptr Void)) {-| __C declaration:__ @my_realloc@ __defined at:__ @functions\/fun_attributes.h:29:7@ @@ -531,8 +586,20 @@ foreign import ccall safe "hs_bindgen_733b29547ce864f6" my_calloc :: Size_t -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_realloc@ -} -foreign import ccall safe "hs_bindgen_4c69efa2a8a2b7c0" my_realloc :: Ptr Void -> - Size_t -> IO (Ptr Void) +my_realloc :: Ptr Void -> Size_t -> IO (Ptr Void) +{-| __C declaration:__ @my_realloc@ + + __defined at:__ @functions\/fun_attributes.h:29:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_realloc@ +-} +my_realloc = fromBaseForeignType my_realloc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1eae846583dd415c" my_alloc1_base :: BaseForeignType (Size_t -> + IO (Ptr Void)) {-| __C declaration:__ @my_alloc1@ __defined at:__ @functions\/fun_attributes.h:34:7@ @@ -541,8 +608,29 @@ foreign import ccall safe "hs_bindgen_4c69efa2a8a2b7c0" my_realloc :: Ptr Void - __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc1@ -} -foreign import ccall safe "hs_bindgen_1eae846583dd415c" my_alloc1 :: Size_t -> - IO (Ptr Void) +my_alloc1 :: Size_t -> IO (Ptr Void) +{-| __C declaration:__ @my_alloc1@ + + __defined at:__ @functions\/fun_attributes.h:34:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc1@ +-} +my_alloc1 = fromBaseForeignType my_alloc1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_790482b4016de326" my_alloc2_base :: BaseForeignType (Size_t -> + IO (Ptr Void)) +{-| __C declaration:__ @my_alloc2@ + + __defined at:__ @functions\/fun_attributes.h:35:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc2@ +-} +my_alloc2 :: Size_t -> IO (Ptr Void) {-| __C declaration:__ @my_alloc2@ __defined at:__ @functions\/fun_attributes.h:35:7@ @@ -551,8 +639,11 @@ foreign import ccall safe "hs_bindgen_1eae846583dd415c" my_alloc1 :: Size_t -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc2@ -} -foreign import ccall safe "hs_bindgen_790482b4016de326" my_alloc2 :: Size_t -> - IO (Ptr Void) +my_alloc2 = fromBaseForeignType my_alloc2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3f72dedf649beccd" square_base :: BaseForeignType (CInt -> + CInt) {-| __C declaration:__ @square@ __defined at:__ @functions\/fun_attributes.h:39:5@ @@ -561,8 +652,19 @@ foreign import ccall safe "hs_bindgen_790482b4016de326" my_alloc2 :: Size_t -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_square@ -} -foreign import ccall safe "hs_bindgen_3f72dedf649beccd" square :: CInt -> - CInt +square :: CInt -> CInt +{-| __C declaration:__ @square@ + + __defined at:__ @functions\/fun_attributes.h:39:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_square@ +-} +square = fromBaseForeignType square_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a8f71f2272dae572" old_fn_deprecated_base :: BaseForeignType (IO CInt) {-| __C declaration:__ @old_fn_deprecated@ __defined at:__ @functions\/fun_attributes.h:48:5@ @@ -571,7 +673,21 @@ foreign import ccall safe "hs_bindgen_3f72dedf649beccd" square :: CInt -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_old_fn_deprecated@ -} -foreign import ccall safe "hs_bindgen_a8f71f2272dae572" old_fn_deprecated :: IO CInt +old_fn_deprecated :: IO CInt +{-| __C declaration:__ @old_fn_deprecated@ + + __defined at:__ @functions\/fun_attributes.h:48:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_old_fn_deprecated@ +-} +old_fn_deprecated = fromBaseForeignType old_fn_deprecated_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_11a623401451cca5" my_dgettext_base :: BaseForeignType (Ptr CChar -> + Ptr CChar -> + IO (Ptr CChar)) {-| __C declaration:__ @my_dgettext@ __defined at:__ @functions\/fun_attributes.h:64:1@ @@ -580,8 +696,30 @@ foreign import ccall safe "hs_bindgen_a8f71f2272dae572" old_fn_deprecated :: IO __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_dgettext@ -} -foreign import ccall safe "hs_bindgen_11a623401451cca5" my_dgettext :: Ptr CChar -> - Ptr CChar -> IO (Ptr CChar) +my_dgettext :: Ptr CChar -> Ptr CChar -> IO (Ptr CChar) +{-| __C declaration:__ @my_dgettext@ + + __defined at:__ @functions\/fun_attributes.h:64:1@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_dgettext@ +-} +my_dgettext = fromBaseForeignType my_dgettext_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_30143e337a327ef0" fdopen_base :: BaseForeignType (CInt -> + Ptr CChar -> + IO (Ptr FILE)) +{-| __C declaration:__ @fdopen@ + + __defined at:__ @functions\/fun_attributes.h:75:9@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_fdopen@ +-} +fdopen :: CInt -> Ptr CChar -> IO (Ptr FILE) {-| __C declaration:__ @fdopen@ __defined at:__ @functions\/fun_attributes.h:75:9@ @@ -590,8 +728,10 @@ foreign import ccall safe "hs_bindgen_11a623401451cca5" my_dgettext :: Ptr CChar __unique:__ @test_functionsfun_attributes_Example_Unsafe_fdopen@ -} -foreign import ccall safe "hs_bindgen_30143e337a327ef0" fdopen :: CInt -> - Ptr CChar -> IO (Ptr FILE) +fdopen = fromBaseForeignType fdopen_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7b2c420d0febf062" f2_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f2@ __defined at:__ @functions\/fun_attributes.h:79:65@ @@ -600,7 +740,31 @@ foreign import ccall safe "hs_bindgen_30143e337a327ef0" fdopen :: CInt -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_f2@ -} -foreign import ccall safe "hs_bindgen_7b2c420d0febf062" f2 :: IO Unit +f2 :: IO Unit +{-| __C declaration:__ @f2@ + + __defined at:__ @functions\/fun_attributes.h:79:65@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_f2@ +-} +f2 = fromBaseForeignType f2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_af1f131d9e98a2ff" my_memcpy_base :: BaseForeignType (Ptr Void -> + Ptr Void -> + Size_t -> + IO (Ptr Void)) +{-| __C declaration:__ @my_memcpy@ + + __defined at:__ @functions\/fun_attributes.h:85:1@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memcpy@ +-} +my_memcpy :: Ptr Void -> Ptr Void -> Size_t -> IO (Ptr Void) {-| __C declaration:__ @my_memcpy@ __defined at:__ @functions\/fun_attributes.h:85:1@ @@ -609,9 +773,19 @@ foreign import ccall safe "hs_bindgen_7b2c420d0febf062" f2 :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memcpy@ -} -foreign import ccall safe "hs_bindgen_af1f131d9e98a2ff" my_memcpy :: Ptr Void -> - Ptr Void -> - Size_t -> IO (Ptr Void) +my_memcpy = fromBaseForeignType my_memcpy_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0afa6ff8226517c8" fatal_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @fatal@ + + __defined at:__ @functions\/fun_attributes.h:102:6@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_fatal@ +-} +fatal :: IO Unit {-| __C declaration:__ @fatal@ __defined at:__ @functions\/fun_attributes.h:102:6@ @@ -620,7 +794,11 @@ foreign import ccall safe "hs_bindgen_af1f131d9e98a2ff" my_memcpy :: Ptr Void -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_fatal@ -} -foreign import ccall safe "hs_bindgen_0afa6ff8226517c8" fatal :: IO Unit +fatal = fromBaseForeignType fatal_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_948fc14ee9d5d56f" hash_base :: BaseForeignType (Ptr CChar -> + IO CInt) {-| Marked @__attribute((pure))__@ @@ -633,8 +811,24 @@ __exported by:__ @functions\/fun_attributes.h@ __unique:__ @test_functionsfun_attributes_Example_Unsafe_hash@ -} -foreign import ccall safe "hs_bindgen_948fc14ee9d5d56f" hash :: Ptr CChar -> - IO CInt +hash :: Ptr CChar -> IO CInt +{-| + + Marked @__attribute((pure))__@ + +__C declaration:__ @hash@ + +__defined at:__ @functions\/fun_attributes.h:110:5@ + +__exported by:__ @functions\/fun_attributes.h@ + +__unique:__ @test_functionsfun_attributes_Example_Unsafe_hash@ +-} +hash = fromBaseForeignType hash_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_60517fb6ae2517ff" mymalloc_base :: BaseForeignType (Size_t -> + IO (Ptr Void)) {-| __C declaration:__ @mymalloc@ __defined at:__ @functions\/fun_attributes.h:115:1@ @@ -643,8 +837,19 @@ foreign import ccall safe "hs_bindgen_948fc14ee9d5d56f" hash :: Ptr CChar -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_mymalloc@ -} -foreign import ccall safe "hs_bindgen_60517fb6ae2517ff" mymalloc :: Size_t -> - IO (Ptr Void) +mymalloc :: Size_t -> IO (Ptr Void) +{-| __C declaration:__ @mymalloc@ + + __defined at:__ @functions\/fun_attributes.h:115:1@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_mymalloc@ +-} +mymalloc = fromBaseForeignType mymalloc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f1451b46f1bd3813" foobar_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @foobar@ __defined at:__ @functions\/fun_attributes.h:119:13@ @@ -653,7 +858,28 @@ foreign import ccall safe "hs_bindgen_60517fb6ae2517ff" mymalloc :: Size_t -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_foobar@ -} -foreign import ccall safe "hs_bindgen_f1451b46f1bd3813" foobar :: IO Unit +foobar :: IO Unit +{-| __C declaration:__ @foobar@ + + __defined at:__ @functions\/fun_attributes.h:119:13@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_foobar@ +-} +foobar = fromBaseForeignType foobar_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_07f5843dd5c65611" core2_func_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @core2_func@ + + __defined at:__ @functions\/fun_attributes.h:126:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_core2_func@ +-} +core2_func :: IO CInt {-| __C declaration:__ @core2_func@ __defined at:__ @functions\/fun_attributes.h:126:5@ @@ -662,7 +888,19 @@ foreign import ccall safe "hs_bindgen_f1451b46f1bd3813" foobar :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_core2_func@ -} -foreign import ccall safe "hs_bindgen_07f5843dd5c65611" core2_func :: IO CInt +core2_func = fromBaseForeignType core2_func_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2c7c9e9a45042696" sse3_func_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @sse3_func@ + + __defined at:__ @functions\/fun_attributes.h:127:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_sse3_func@ +-} +sse3_func :: IO CInt {-| __C declaration:__ @sse3_func@ __defined at:__ @functions\/fun_attributes.h:127:5@ @@ -671,7 +909,10 @@ foreign import ccall safe "hs_bindgen_07f5843dd5c65611" core2_func :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_sse3_func@ -} -foreign import ccall safe "hs_bindgen_2c7c9e9a45042696" sse3_func :: IO CInt +sse3_func = fromBaseForeignType sse3_func_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4ff2d7abd6099082" f3_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @f3@ __defined at:__ @functions\/fun_attributes.h:131:49@ @@ -680,7 +921,28 @@ foreign import ccall safe "hs_bindgen_2c7c9e9a45042696" sse3_func :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_f3@ -} -foreign import ccall safe "hs_bindgen_4ff2d7abd6099082" f3 :: IO Unit +f3 :: IO Unit +{-| __C declaration:__ @f3@ + + __defined at:__ @functions\/fun_attributes.h:131:49@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_f3@ +-} +f3 = fromBaseForeignType f3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c3ae037518ec9b4e" fn_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @fn@ + + __defined at:__ @functions\/fun_attributes.h:136:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_fn@ +-} +fn :: IO CInt {-| __C declaration:__ @fn@ __defined at:__ @functions\/fun_attributes.h:136:5@ @@ -689,7 +951,19 @@ foreign import ccall safe "hs_bindgen_4ff2d7abd6099082" f3 :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_fn@ -} -foreign import ccall safe "hs_bindgen_c3ae037518ec9b4e" fn :: IO CInt +fn = fromBaseForeignType fn_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_da9708096863a242" y_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @y@ + + __defined at:__ @functions\/fun_attributes.h:142:12@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_y@ +-} +y :: IO CInt {-| __C declaration:__ @y@ __defined at:__ @functions\/fun_attributes.h:142:12@ @@ -698,7 +972,10 @@ foreign import ccall safe "hs_bindgen_c3ae037518ec9b4e" fn :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_y@ -} -foreign import ccall safe "hs_bindgen_da9708096863a242" y :: IO CInt +y = fromBaseForeignType y_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_037c35609f7728b3" x1_base :: BaseForeignType (IO CInt) {-| __C declaration:__ @x1@ __defined at:__ @functions\/fun_attributes.h:145:12@ @@ -707,7 +984,19 @@ foreign import ccall safe "hs_bindgen_da9708096863a242" y :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_x1@ -} -foreign import ccall safe "hs_bindgen_037c35609f7728b3" x1 :: IO CInt +x1 :: IO CInt +{-| __C declaration:__ @x1@ + + __defined at:__ @functions\/fun_attributes.h:145:12@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_x1@ +-} +x1 = fromBaseForeignType x1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2c3e8d78049741c3" x2_base :: BaseForeignType (IO CInt) {-| __C declaration:__ @x2@ __defined at:__ @functions\/fun_attributes.h:148:12@ @@ -716,7 +1005,28 @@ foreign import ccall safe "hs_bindgen_037c35609f7728b3" x1 :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_x2@ -} -foreign import ccall safe "hs_bindgen_2c3e8d78049741c3" x2 :: IO CInt +x2 :: IO CInt +{-| __C declaration:__ @x2@ + + __defined at:__ @functions\/fun_attributes.h:148:12@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_x2@ +-} +x2 = fromBaseForeignType x2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_52759f125bf2b140" __f1_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @__f1@ + + __defined at:__ @functions\/fun_attributes.h:16:13@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe___f1@ +-} +__f1 :: IO Unit {-| __C declaration:__ @__f1@ __defined at:__ @functions\/fun_attributes.h:16:13@ @@ -725,7 +1035,19 @@ foreign import ccall safe "hs_bindgen_2c3e8d78049741c3" x2 :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe___f1@ -} -foreign import ccall safe "hs_bindgen_52759f125bf2b140" __f1 :: IO Unit +__f1 = fromBaseForeignType __f1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_80bb9d1445e894ca" f1_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f1@ + + __defined at:__ @functions\/fun_attributes.h:19:6@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_f1@ +-} +f1 :: IO Unit {-| __C declaration:__ @f1@ __defined at:__ @functions\/fun_attributes.h:19:6@ @@ -734,7 +1056,12 @@ foreign import ccall safe "hs_bindgen_52759f125bf2b140" __f1 :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_f1@ -} -foreign import ccall safe "hs_bindgen_80bb9d1445e894ca" f1 :: IO Unit +f1 = fromBaseForeignType f1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ebf8d1f009064640" my_memalign_base :: BaseForeignType (Size_t -> + Size_t -> + IO (Ptr Void)) {-| __C declaration:__ @my_memalign@ __defined at:__ @functions\/fun_attributes.h:23:7@ @@ -743,18 +1070,53 @@ foreign import ccall safe "hs_bindgen_80bb9d1445e894ca" f1 :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memalign@ -} -foreign import ccall safe "hs_bindgen_ebf8d1f009064640" my_memalign :: Size_t -> - Size_t -> IO (Ptr Void) -{-| __C declaration:__ @my_calloc@ +my_memalign :: Size_t -> Size_t -> IO (Ptr Void) +{-| __C declaration:__ @my_memalign@ + + __defined at:__ @functions\/fun_attributes.h:23:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memalign@ +-} +my_memalign = fromBaseForeignType my_memalign_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a062d8e757dc6824" my_calloc_base :: BaseForeignType (Size_t -> + Size_t -> + IO (Ptr Void)) +{-| __C declaration:__ @my_calloc@ + + __defined at:__ @functions\/fun_attributes.h:28:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_calloc@ +-} +my_calloc :: Size_t -> Size_t -> IO (Ptr Void) +{-| __C declaration:__ @my_calloc@ + + __defined at:__ @functions\/fun_attributes.h:28:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_calloc@ +-} +my_calloc = fromBaseForeignType my_calloc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_899561850b80c305" my_realloc_base :: BaseForeignType (Ptr Void -> + Size_t -> + IO (Ptr Void)) +{-| __C declaration:__ @my_realloc@ - __defined at:__ @functions\/fun_attributes.h:28:7@ + __defined at:__ @functions\/fun_attributes.h:29:7@ __exported by:__ @functions\/fun_attributes.h@ - __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_calloc@ + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_realloc@ -} -foreign import ccall safe "hs_bindgen_a062d8e757dc6824" my_calloc :: Size_t -> - Size_t -> IO (Ptr Void) +my_realloc :: Ptr Void -> Size_t -> IO (Ptr Void) {-| __C declaration:__ @my_realloc@ __defined at:__ @functions\/fun_attributes.h:29:7@ @@ -763,8 +1125,20 @@ foreign import ccall safe "hs_bindgen_a062d8e757dc6824" my_calloc :: Size_t -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_realloc@ -} -foreign import ccall safe "hs_bindgen_899561850b80c305" my_realloc :: Ptr Void -> - Size_t -> IO (Ptr Void) +my_realloc = fromBaseForeignType my_realloc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d5eb45f9de991bca" my_alloc1_base :: BaseForeignType (Size_t -> + IO (Ptr Void)) +{-| __C declaration:__ @my_alloc1@ + + __defined at:__ @functions\/fun_attributes.h:34:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc1@ +-} +my_alloc1 :: Size_t -> IO (Ptr Void) {-| __C declaration:__ @my_alloc1@ __defined at:__ @functions\/fun_attributes.h:34:7@ @@ -773,8 +1147,11 @@ foreign import ccall safe "hs_bindgen_899561850b80c305" my_realloc :: Ptr Void - __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc1@ -} -foreign import ccall safe "hs_bindgen_d5eb45f9de991bca" my_alloc1 :: Size_t -> - IO (Ptr Void) +my_alloc1 = fromBaseForeignType my_alloc1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a7aa3949fa7cae3f" my_alloc2_base :: BaseForeignType (Size_t -> + IO (Ptr Void)) {-| __C declaration:__ @my_alloc2@ __defined at:__ @functions\/fun_attributes.h:35:7@ @@ -783,8 +1160,29 @@ foreign import ccall safe "hs_bindgen_d5eb45f9de991bca" my_alloc1 :: Size_t -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc2@ -} -foreign import ccall safe "hs_bindgen_a7aa3949fa7cae3f" my_alloc2 :: Size_t -> - IO (Ptr Void) +my_alloc2 :: Size_t -> IO (Ptr Void) +{-| __C declaration:__ @my_alloc2@ + + __defined at:__ @functions\/fun_attributes.h:35:7@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_alloc2@ +-} +my_alloc2 = fromBaseForeignType my_alloc2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dbe49279b6585cea" square_base :: BaseForeignType (CInt -> + CInt) +{-| __C declaration:__ @square@ + + __defined at:__ @functions\/fun_attributes.h:39:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_square@ +-} +square :: CInt -> CInt {-| __C declaration:__ @square@ __defined at:__ @functions\/fun_attributes.h:39:5@ @@ -793,8 +1191,19 @@ foreign import ccall safe "hs_bindgen_a7aa3949fa7cae3f" my_alloc2 :: Size_t -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_square@ -} -foreign import ccall safe "hs_bindgen_dbe49279b6585cea" square :: CInt -> - CInt +square = fromBaseForeignType square_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f51c36dd7e8f4133" old_fn_deprecated_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @old_fn_deprecated@ + + __defined at:__ @functions\/fun_attributes.h:48:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_old_fn_deprecated@ +-} +old_fn_deprecated :: IO CInt {-| __C declaration:__ @old_fn_deprecated@ __defined at:__ @functions\/fun_attributes.h:48:5@ @@ -803,7 +1212,21 @@ foreign import ccall safe "hs_bindgen_dbe49279b6585cea" square :: CInt -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_old_fn_deprecated@ -} -foreign import ccall safe "hs_bindgen_f51c36dd7e8f4133" old_fn_deprecated :: IO CInt +old_fn_deprecated = fromBaseForeignType old_fn_deprecated_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bf6f222178bd7c31" my_dgettext_base :: BaseForeignType (Ptr CChar -> + Ptr CChar -> + IO (Ptr CChar)) +{-| __C declaration:__ @my_dgettext@ + + __defined at:__ @functions\/fun_attributes.h:64:1@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_dgettext@ +-} +my_dgettext :: Ptr CChar -> Ptr CChar -> IO (Ptr CChar) {-| __C declaration:__ @my_dgettext@ __defined at:__ @functions\/fun_attributes.h:64:1@ @@ -812,8 +1235,21 @@ foreign import ccall safe "hs_bindgen_f51c36dd7e8f4133" old_fn_deprecated :: IO __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_dgettext@ -} -foreign import ccall safe "hs_bindgen_bf6f222178bd7c31" my_dgettext :: Ptr CChar -> - Ptr CChar -> IO (Ptr CChar) +my_dgettext = fromBaseForeignType my_dgettext_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_830629dc11c2fdfc" fdopen_base :: BaseForeignType (CInt -> + Ptr CChar -> + IO (Ptr FILE)) +{-| __C declaration:__ @fdopen@ + + __defined at:__ @functions\/fun_attributes.h:75:9@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_fdopen@ +-} +fdopen :: CInt -> Ptr CChar -> IO (Ptr FILE) {-| __C declaration:__ @fdopen@ __defined at:__ @functions\/fun_attributes.h:75:9@ @@ -822,8 +1258,19 @@ foreign import ccall safe "hs_bindgen_bf6f222178bd7c31" my_dgettext :: Ptr CChar __unique:__ @test_functionsfun_attributes_Example_Unsafe_fdopen@ -} -foreign import ccall safe "hs_bindgen_830629dc11c2fdfc" fdopen :: CInt -> - Ptr CChar -> IO (Ptr FILE) +fdopen = fromBaseForeignType fdopen_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a5f34f5beb1c74f1" f2_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f2@ + + __defined at:__ @functions\/fun_attributes.h:79:65@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_f2@ +-} +f2 :: IO Unit {-| __C declaration:__ @f2@ __defined at:__ @functions\/fun_attributes.h:79:65@ @@ -832,7 +1279,22 @@ foreign import ccall safe "hs_bindgen_830629dc11c2fdfc" fdopen :: CInt -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_f2@ -} -foreign import ccall safe "hs_bindgen_a5f34f5beb1c74f1" f2 :: IO Unit +f2 = fromBaseForeignType f2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0f3586df383dffea" my_memcpy_base :: BaseForeignType (Ptr Void -> + Ptr Void -> + Size_t -> + IO (Ptr Void)) +{-| __C declaration:__ @my_memcpy@ + + __defined at:__ @functions\/fun_attributes.h:85:1@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memcpy@ +-} +my_memcpy :: Ptr Void -> Ptr Void -> Size_t -> IO (Ptr Void) {-| __C declaration:__ @my_memcpy@ __defined at:__ @functions\/fun_attributes.h:85:1@ @@ -841,9 +1303,19 @@ foreign import ccall safe "hs_bindgen_a5f34f5beb1c74f1" f2 :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_my_memcpy@ -} -foreign import ccall safe "hs_bindgen_0f3586df383dffea" my_memcpy :: Ptr Void -> - Ptr Void -> - Size_t -> IO (Ptr Void) +my_memcpy = fromBaseForeignType my_memcpy_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_667d3280d945cd0c" fatal_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @fatal@ + + __defined at:__ @functions\/fun_attributes.h:102:6@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_fatal@ +-} +fatal :: IO Unit {-| __C declaration:__ @fatal@ __defined at:__ @functions\/fun_attributes.h:102:6@ @@ -852,7 +1324,24 @@ foreign import ccall safe "hs_bindgen_0f3586df383dffea" my_memcpy :: Ptr Void -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_fatal@ -} -foreign import ccall safe "hs_bindgen_667d3280d945cd0c" fatal :: IO Unit +fatal = fromBaseForeignType fatal_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_394fd662d5fb7aa6" hash_base :: BaseForeignType (Ptr CChar -> + IO CInt) +{-| + + Marked @__attribute((pure))__@ + +__C declaration:__ @hash@ + +__defined at:__ @functions\/fun_attributes.h:110:5@ + +__exported by:__ @functions\/fun_attributes.h@ + +__unique:__ @test_functionsfun_attributes_Example_Unsafe_hash@ +-} +hash :: Ptr CChar -> IO CInt {-| Marked @__attribute((pure))__@ @@ -865,8 +1354,20 @@ __exported by:__ @functions\/fun_attributes.h@ __unique:__ @test_functionsfun_attributes_Example_Unsafe_hash@ -} -foreign import ccall safe "hs_bindgen_394fd662d5fb7aa6" hash :: Ptr CChar -> - IO CInt +hash = fromBaseForeignType hash_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5594a84fb65782e1" mymalloc_base :: BaseForeignType (Size_t -> + IO (Ptr Void)) +{-| __C declaration:__ @mymalloc@ + + __defined at:__ @functions\/fun_attributes.h:115:1@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_mymalloc@ +-} +mymalloc :: Size_t -> IO (Ptr Void) {-| __C declaration:__ @mymalloc@ __defined at:__ @functions\/fun_attributes.h:115:1@ @@ -875,8 +1376,19 @@ foreign import ccall safe "hs_bindgen_394fd662d5fb7aa6" hash :: Ptr CChar -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_mymalloc@ -} -foreign import ccall safe "hs_bindgen_5594a84fb65782e1" mymalloc :: Size_t -> - IO (Ptr Void) +mymalloc = fromBaseForeignType mymalloc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1f19397195b32853" foobar_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @foobar@ + + __defined at:__ @functions\/fun_attributes.h:119:13@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_foobar@ +-} +foobar :: IO Unit {-| __C declaration:__ @foobar@ __defined at:__ @functions\/fun_attributes.h:119:13@ @@ -885,7 +1397,19 @@ foreign import ccall safe "hs_bindgen_5594a84fb65782e1" mymalloc :: Size_t -> __unique:__ @test_functionsfun_attributes_Example_Unsafe_foobar@ -} -foreign import ccall safe "hs_bindgen_1f19397195b32853" foobar :: IO Unit +foobar = fromBaseForeignType foobar_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f80f9b58791a9cf2" core2_func_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @core2_func@ + + __defined at:__ @functions\/fun_attributes.h:126:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_core2_func@ +-} +core2_func :: IO CInt {-| __C declaration:__ @core2_func@ __defined at:__ @functions\/fun_attributes.h:126:5@ @@ -894,7 +1418,10 @@ foreign import ccall safe "hs_bindgen_1f19397195b32853" foobar :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_core2_func@ -} -foreign import ccall safe "hs_bindgen_f80f9b58791a9cf2" core2_func :: IO CInt +core2_func = fromBaseForeignType core2_func_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6a951361c18a91a0" sse3_func_base :: BaseForeignType (IO CInt) {-| __C declaration:__ @sse3_func@ __defined at:__ @functions\/fun_attributes.h:127:5@ @@ -903,7 +1430,28 @@ foreign import ccall safe "hs_bindgen_f80f9b58791a9cf2" core2_func :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_sse3_func@ -} -foreign import ccall safe "hs_bindgen_6a951361c18a91a0" sse3_func :: IO CInt +sse3_func :: IO CInt +{-| __C declaration:__ @sse3_func@ + + __defined at:__ @functions\/fun_attributes.h:127:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_sse3_func@ +-} +sse3_func = fromBaseForeignType sse3_func_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1d7f2cdf95b3bfa3" f3_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @f3@ + + __defined at:__ @functions\/fun_attributes.h:131:49@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_f3@ +-} +f3 :: IO Unit {-| __C declaration:__ @f3@ __defined at:__ @functions\/fun_attributes.h:131:49@ @@ -912,7 +1460,19 @@ foreign import ccall safe "hs_bindgen_6a951361c18a91a0" sse3_func :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_f3@ -} -foreign import ccall safe "hs_bindgen_1d7f2cdf95b3bfa3" f3 :: IO Unit +f3 = fromBaseForeignType f3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c1fff017165ba0e1" fn_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @fn@ + + __defined at:__ @functions\/fun_attributes.h:136:5@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_fn@ +-} +fn :: IO CInt {-| __C declaration:__ @fn@ __defined at:__ @functions\/fun_attributes.h:136:5@ @@ -921,7 +1481,19 @@ foreign import ccall safe "hs_bindgen_1d7f2cdf95b3bfa3" f3 :: IO Unit __unique:__ @test_functionsfun_attributes_Example_Unsafe_fn@ -} -foreign import ccall safe "hs_bindgen_c1fff017165ba0e1" fn :: IO CInt +fn = fromBaseForeignType fn_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_67dc9f91fbda20c7" y_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @y@ + + __defined at:__ @functions\/fun_attributes.h:142:12@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_y@ +-} +y :: IO CInt {-| __C declaration:__ @y@ __defined at:__ @functions\/fun_attributes.h:142:12@ @@ -930,7 +1502,19 @@ foreign import ccall safe "hs_bindgen_c1fff017165ba0e1" fn :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_y@ -} -foreign import ccall safe "hs_bindgen_67dc9f91fbda20c7" y :: IO CInt +y = fromBaseForeignType y_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8562db8b96c10d6b" x1_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @x1@ + + __defined at:__ @functions\/fun_attributes.h:145:12@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_x1@ +-} +x1 :: IO CInt {-| __C declaration:__ @x1@ __defined at:__ @functions\/fun_attributes.h:145:12@ @@ -939,7 +1523,19 @@ foreign import ccall safe "hs_bindgen_67dc9f91fbda20c7" y :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_x1@ -} -foreign import ccall safe "hs_bindgen_8562db8b96c10d6b" x1 :: IO CInt +x1 = fromBaseForeignType x1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_150a79fec58eaf56" x2_base :: BaseForeignType (IO CInt) +{-| __C declaration:__ @x2@ + + __defined at:__ @functions\/fun_attributes.h:148:12@ + + __exported by:__ @functions\/fun_attributes.h@ + + __unique:__ @test_functionsfun_attributes_Example_Unsafe_x2@ +-} +x2 :: IO CInt {-| __C declaration:__ @x2@ __defined at:__ @functions\/fun_attributes.h:148:12@ @@ -948,10 +1544,16 @@ foreign import ccall safe "hs_bindgen_8562db8b96c10d6b" x1 :: IO CInt __unique:__ @test_functionsfun_attributes_Example_Unsafe_x2@ -} -foreign import ccall safe "hs_bindgen_150a79fec58eaf56" x2 :: IO CInt +x2 = fromBaseForeignType x2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_24a849cc3a4a1da5" hs_bindgen_24a849cc3a4a1da5_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_functionsfun_attributes_Example_get___f1_ptr@ +-} +hs_bindgen_24a849cc3a4a1da5 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_functionsfun_attributes_Example_get___f1_ptr@ -} -foreign import ccall safe "hs_bindgen_24a849cc3a4a1da5" hs_bindgen_24a849cc3a4a1da5 :: IO (FunPtr (IO Unit)) +hs_bindgen_24a849cc3a4a1da5 = fromBaseForeignType hs_bindgen_24a849cc3a4a1da5_base {-# NOINLINE __f1_ptr #-} {-| __C declaration:__ @__f1@ @@ -967,9 +1569,15 @@ __f1_ptr :: FunPtr (IO Unit) __exported by:__ @functions\/fun_attributes.h@ -} __f1_ptr = unsafePerformIO hs_bindgen_24a849cc3a4a1da5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0e7d1a5941234285" hs_bindgen_0e7d1a5941234285_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_f1_ptr@ +-} +hs_bindgen_0e7d1a5941234285 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_functionsfun_attributes_Example_get_f1_ptr@ -} -foreign import ccall safe "hs_bindgen_0e7d1a5941234285" hs_bindgen_0e7d1a5941234285 :: IO (FunPtr (IO Unit)) +hs_bindgen_0e7d1a5941234285 = fromBaseForeignType hs_bindgen_0e7d1a5941234285_base {-# NOINLINE f1_ptr #-} {-| __C declaration:__ @f1@ @@ -985,11 +1593,18 @@ f1_ptr :: FunPtr (IO Unit) __exported by:__ @functions\/fun_attributes.h@ -} f1_ptr = unsafePerformIO hs_bindgen_0e7d1a5941234285 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_08646a1466ab9e1b" hs_bindgen_08646a1466ab9e1b_base :: BaseForeignType (IO (FunPtr (Size_t -> + Size_t -> + IO (Ptr Void)))) {-| __unique:__ @test_functionsfun_attributes_Example_get_my_memalign_ptr@ -} -foreign import ccall safe "hs_bindgen_08646a1466ab9e1b" hs_bindgen_08646a1466ab9e1b :: IO (FunPtr (Size_t -> - Size_t -> - IO (Ptr Void))) +hs_bindgen_08646a1466ab9e1b :: IO (FunPtr (Size_t -> + Size_t -> IO (Ptr Void))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_my_memalign_ptr@ +-} +hs_bindgen_08646a1466ab9e1b = fromBaseForeignType hs_bindgen_08646a1466ab9e1b_base {-# NOINLINE my_memalign_ptr #-} {-| __C declaration:__ @my_memalign@ @@ -1005,11 +1620,18 @@ my_memalign_ptr :: FunPtr (Size_t -> Size_t -> IO (Ptr Void)) __exported by:__ @functions\/fun_attributes.h@ -} my_memalign_ptr = unsafePerformIO hs_bindgen_08646a1466ab9e1b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ed6d281e7bfe4523" hs_bindgen_ed6d281e7bfe4523_base :: BaseForeignType (IO (FunPtr (Size_t -> + Size_t -> + IO (Ptr Void)))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_my_calloc_ptr@ +-} +hs_bindgen_ed6d281e7bfe4523 :: IO (FunPtr (Size_t -> + Size_t -> IO (Ptr Void))) {-| __unique:__ @test_functionsfun_attributes_Example_get_my_calloc_ptr@ -} -foreign import ccall safe "hs_bindgen_ed6d281e7bfe4523" hs_bindgen_ed6d281e7bfe4523 :: IO (FunPtr (Size_t -> - Size_t -> - IO (Ptr Void))) +hs_bindgen_ed6d281e7bfe4523 = fromBaseForeignType hs_bindgen_ed6d281e7bfe4523_base {-# NOINLINE my_calloc_ptr #-} {-| __C declaration:__ @my_calloc@ @@ -1025,11 +1647,18 @@ my_calloc_ptr :: FunPtr (Size_t -> Size_t -> IO (Ptr Void)) __exported by:__ @functions\/fun_attributes.h@ -} my_calloc_ptr = unsafePerformIO hs_bindgen_ed6d281e7bfe4523 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_24c8bade35b40f21" hs_bindgen_24c8bade35b40f21_base :: BaseForeignType (IO (FunPtr (Ptr Void -> + Size_t -> + IO (Ptr Void)))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_my_realloc_ptr@ +-} +hs_bindgen_24c8bade35b40f21 :: IO (FunPtr (Ptr Void -> + Size_t -> IO (Ptr Void))) {-| __unique:__ @test_functionsfun_attributes_Example_get_my_realloc_ptr@ -} -foreign import ccall safe "hs_bindgen_24c8bade35b40f21" hs_bindgen_24c8bade35b40f21 :: IO (FunPtr (Ptr Void -> - Size_t -> - IO (Ptr Void))) +hs_bindgen_24c8bade35b40f21 = fromBaseForeignType hs_bindgen_24c8bade35b40f21_base {-# NOINLINE my_realloc_ptr #-} {-| __C declaration:__ @my_realloc@ @@ -1045,10 +1674,17 @@ my_realloc_ptr :: FunPtr (Ptr Void -> Size_t -> IO (Ptr Void)) __exported by:__ @functions\/fun_attributes.h@ -} my_realloc_ptr = unsafePerformIO hs_bindgen_24c8bade35b40f21 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_930dccd393b8f937" hs_bindgen_930dccd393b8f937_base :: BaseForeignType (IO (FunPtr (Size_t -> + IO (Ptr Void)))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_my_alloc1_ptr@ +-} +hs_bindgen_930dccd393b8f937 :: IO (FunPtr (Size_t -> + IO (Ptr Void))) {-| __unique:__ @test_functionsfun_attributes_Example_get_my_alloc1_ptr@ -} -foreign import ccall safe "hs_bindgen_930dccd393b8f937" hs_bindgen_930dccd393b8f937 :: IO (FunPtr (Size_t -> - IO (Ptr Void))) +hs_bindgen_930dccd393b8f937 = fromBaseForeignType hs_bindgen_930dccd393b8f937_base {-# NOINLINE my_alloc1_ptr #-} {-| __C declaration:__ @my_alloc1@ @@ -1064,10 +1700,17 @@ my_alloc1_ptr :: FunPtr (Size_t -> IO (Ptr Void)) __exported by:__ @functions\/fun_attributes.h@ -} my_alloc1_ptr = unsafePerformIO hs_bindgen_930dccd393b8f937 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b15d8039514faa44" hs_bindgen_b15d8039514faa44_base :: BaseForeignType (IO (FunPtr (Size_t -> + IO (Ptr Void)))) {-| __unique:__ @test_functionsfun_attributes_Example_get_my_alloc2_ptr@ -} -foreign import ccall safe "hs_bindgen_b15d8039514faa44" hs_bindgen_b15d8039514faa44 :: IO (FunPtr (Size_t -> - IO (Ptr Void))) +hs_bindgen_b15d8039514faa44 :: IO (FunPtr (Size_t -> + IO (Ptr Void))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_my_alloc2_ptr@ +-} +hs_bindgen_b15d8039514faa44 = fromBaseForeignType hs_bindgen_b15d8039514faa44_base {-# NOINLINE my_alloc2_ptr #-} {-| __C declaration:__ @my_alloc2@ @@ -1083,10 +1726,16 @@ my_alloc2_ptr :: FunPtr (Size_t -> IO (Ptr Void)) __exported by:__ @functions\/fun_attributes.h@ -} my_alloc2_ptr = unsafePerformIO hs_bindgen_b15d8039514faa44 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9a26c4f7828e9f21" hs_bindgen_9a26c4f7828e9f21_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_square_ptr@ +-} +hs_bindgen_9a26c4f7828e9f21 :: IO (FunPtr (CInt -> IO CInt)) {-| __unique:__ @test_functionsfun_attributes_Example_get_square_ptr@ -} -foreign import ccall safe "hs_bindgen_9a26c4f7828e9f21" hs_bindgen_9a26c4f7828e9f21 :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_9a26c4f7828e9f21 = fromBaseForeignType hs_bindgen_9a26c4f7828e9f21_base {-# NOINLINE square_ptr #-} {-| __C declaration:__ @square@ @@ -1102,9 +1751,15 @@ square_ptr :: FunPtr (CInt -> IO CInt) __exported by:__ @functions\/fun_attributes.h@ -} square_ptr = unsafePerformIO hs_bindgen_9a26c4f7828e9f21 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_75b7d9140b40148e" hs_bindgen_75b7d9140b40148e_base :: BaseForeignType (IO (FunPtr (IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_old_fn_deprecated_ptr@ +-} +hs_bindgen_75b7d9140b40148e :: IO (FunPtr (IO CInt)) {-| __unique:__ @test_functionsfun_attributes_Example_get_old_fn_deprecated_ptr@ -} -foreign import ccall safe "hs_bindgen_75b7d9140b40148e" hs_bindgen_75b7d9140b40148e :: IO (FunPtr (IO CInt)) +hs_bindgen_75b7d9140b40148e = fromBaseForeignType hs_bindgen_75b7d9140b40148e_base {-# NOINLINE old_fn_deprecated_ptr #-} {-| __C declaration:__ @old_fn_deprecated@ @@ -1120,11 +1775,18 @@ old_fn_deprecated_ptr :: FunPtr (IO CInt) __exported by:__ @functions\/fun_attributes.h@ -} old_fn_deprecated_ptr = unsafePerformIO hs_bindgen_75b7d9140b40148e +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_880fe66e7b0bf3df" hs_bindgen_880fe66e7b0bf3df_base :: BaseForeignType (IO (FunPtr (Ptr CChar -> + Ptr CChar -> + IO (Ptr CChar)))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_my_dgettext_ptr@ +-} +hs_bindgen_880fe66e7b0bf3df :: IO (FunPtr (Ptr CChar -> + Ptr CChar -> IO (Ptr CChar))) {-| __unique:__ @test_functionsfun_attributes_Example_get_my_dgettext_ptr@ -} -foreign import ccall safe "hs_bindgen_880fe66e7b0bf3df" hs_bindgen_880fe66e7b0bf3df :: IO (FunPtr (Ptr CChar -> - Ptr CChar -> - IO (Ptr CChar))) +hs_bindgen_880fe66e7b0bf3df = fromBaseForeignType hs_bindgen_880fe66e7b0bf3df_base {-# NOINLINE my_dgettext_ptr #-} {-| __C declaration:__ @my_dgettext@ @@ -1141,11 +1803,18 @@ my_dgettext_ptr :: FunPtr (Ptr CChar -> __exported by:__ @functions\/fun_attributes.h@ -} my_dgettext_ptr = unsafePerformIO hs_bindgen_880fe66e7b0bf3df +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e36b210e874d5d42" hs_bindgen_e36b210e874d5d42_base :: BaseForeignType (IO (FunPtr (CInt -> + Ptr CChar -> + IO (Ptr FILE)))) {-| __unique:__ @test_functionsfun_attributes_Example_get_fdopen_ptr@ -} -foreign import ccall safe "hs_bindgen_e36b210e874d5d42" hs_bindgen_e36b210e874d5d42 :: IO (FunPtr (CInt -> - Ptr CChar -> - IO (Ptr FILE))) +hs_bindgen_e36b210e874d5d42 :: IO (FunPtr (CInt -> + Ptr CChar -> IO (Ptr FILE))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_fdopen_ptr@ +-} +hs_bindgen_e36b210e874d5d42 = fromBaseForeignType hs_bindgen_e36b210e874d5d42_base {-# NOINLINE fdopen_ptr #-} {-| __C declaration:__ @fdopen@ @@ -1161,9 +1830,15 @@ fdopen_ptr :: FunPtr (CInt -> Ptr CChar -> IO (Ptr FILE)) __exported by:__ @functions\/fun_attributes.h@ -} fdopen_ptr = unsafePerformIO hs_bindgen_e36b210e874d5d42 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_193dba4a732d39a4" hs_bindgen_193dba4a732d39a4_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_f2_ptr@ +-} +hs_bindgen_193dba4a732d39a4 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_functionsfun_attributes_Example_get_f2_ptr@ -} -foreign import ccall safe "hs_bindgen_193dba4a732d39a4" hs_bindgen_193dba4a732d39a4 :: IO (FunPtr (IO Unit)) +hs_bindgen_193dba4a732d39a4 = fromBaseForeignType hs_bindgen_193dba4a732d39a4_base {-# NOINLINE f2_ptr #-} {-| __C declaration:__ @f2@ @@ -1179,12 +1854,19 @@ f2_ptr :: FunPtr (IO Unit) __exported by:__ @functions\/fun_attributes.h@ -} f2_ptr = unsafePerformIO hs_bindgen_193dba4a732d39a4 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_95f5193f59c47586" hs_bindgen_95f5193f59c47586_base :: BaseForeignType (IO (FunPtr (Ptr Void -> + Ptr Void -> + Size_t -> + IO (Ptr Void)))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_my_memcpy_ptr@ +-} +hs_bindgen_95f5193f59c47586 :: IO (FunPtr (Ptr Void -> + Ptr Void -> Size_t -> IO (Ptr Void))) {-| __unique:__ @test_functionsfun_attributes_Example_get_my_memcpy_ptr@ -} -foreign import ccall safe "hs_bindgen_95f5193f59c47586" hs_bindgen_95f5193f59c47586 :: IO (FunPtr (Ptr Void -> - Ptr Void -> - Size_t -> - IO (Ptr Void))) +hs_bindgen_95f5193f59c47586 = fromBaseForeignType hs_bindgen_95f5193f59c47586_base {-# NOINLINE my_memcpy_ptr #-} {-| __C declaration:__ @my_memcpy@ @@ -1201,9 +1883,15 @@ my_memcpy_ptr :: FunPtr (Ptr Void -> __exported by:__ @functions\/fun_attributes.h@ -} my_memcpy_ptr = unsafePerformIO hs_bindgen_95f5193f59c47586 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6944ffce3b5c6e81" hs_bindgen_6944ffce3b5c6e81_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_fatal_ptr@ +-} +hs_bindgen_6944ffce3b5c6e81 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_functionsfun_attributes_Example_get_fatal_ptr@ -} -foreign import ccall safe "hs_bindgen_6944ffce3b5c6e81" hs_bindgen_6944ffce3b5c6e81 :: IO (FunPtr (IO Unit)) +hs_bindgen_6944ffce3b5c6e81 = fromBaseForeignType hs_bindgen_6944ffce3b5c6e81_base {-# NOINLINE fatal_ptr #-} {-| __C declaration:__ @fatal@ @@ -1219,10 +1907,16 @@ fatal_ptr :: FunPtr (IO Unit) __exported by:__ @functions\/fun_attributes.h@ -} fatal_ptr = unsafePerformIO hs_bindgen_6944ffce3b5c6e81 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_71a42f1d6c853302" hs_bindgen_71a42f1d6c853302_base :: BaseForeignType (IO (FunPtr (Ptr CChar -> + IO CInt))) {-| __unique:__ @test_functionsfun_attributes_Example_get_hash_ptr@ -} -foreign import ccall safe "hs_bindgen_71a42f1d6c853302" hs_bindgen_71a42f1d6c853302 :: IO (FunPtr (Ptr CChar -> - IO CInt)) +hs_bindgen_71a42f1d6c853302 :: IO (FunPtr (Ptr CChar -> IO CInt)) +{-| __unique:__ @test_functionsfun_attributes_Example_get_hash_ptr@ +-} +hs_bindgen_71a42f1d6c853302 = fromBaseForeignType hs_bindgen_71a42f1d6c853302_base {-# NOINLINE hash_ptr #-} {-| __C declaration:__ @hash@ @@ -1238,10 +1932,17 @@ hash_ptr :: FunPtr (Ptr CChar -> IO CInt) __exported by:__ @functions\/fun_attributes.h@ -} hash_ptr = unsafePerformIO hs_bindgen_71a42f1d6c853302 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_97fdda2d31fdf3b8" hs_bindgen_97fdda2d31fdf3b8_base :: BaseForeignType (IO (FunPtr (Size_t -> + IO (Ptr Void)))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_mymalloc_ptr@ +-} +hs_bindgen_97fdda2d31fdf3b8 :: IO (FunPtr (Size_t -> + IO (Ptr Void))) {-| __unique:__ @test_functionsfun_attributes_Example_get_mymalloc_ptr@ -} -foreign import ccall safe "hs_bindgen_97fdda2d31fdf3b8" hs_bindgen_97fdda2d31fdf3b8 :: IO (FunPtr (Size_t -> - IO (Ptr Void))) +hs_bindgen_97fdda2d31fdf3b8 = fromBaseForeignType hs_bindgen_97fdda2d31fdf3b8_base {-# NOINLINE mymalloc_ptr #-} {-| __C declaration:__ @mymalloc@ @@ -1257,9 +1958,15 @@ mymalloc_ptr :: FunPtr (Size_t -> IO (Ptr Void)) __exported by:__ @functions\/fun_attributes.h@ -} mymalloc_ptr = unsafePerformIO hs_bindgen_97fdda2d31fdf3b8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f8e2e1e043022d0b" hs_bindgen_f8e2e1e043022d0b_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_foobar_ptr@ +-} +hs_bindgen_f8e2e1e043022d0b :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_functionsfun_attributes_Example_get_foobar_ptr@ -} -foreign import ccall safe "hs_bindgen_f8e2e1e043022d0b" hs_bindgen_f8e2e1e043022d0b :: IO (FunPtr (IO Unit)) +hs_bindgen_f8e2e1e043022d0b = fromBaseForeignType hs_bindgen_f8e2e1e043022d0b_base {-# NOINLINE foobar_ptr #-} {-| __C declaration:__ @foobar@ @@ -1275,9 +1982,15 @@ foobar_ptr :: FunPtr (IO Unit) __exported by:__ @functions\/fun_attributes.h@ -} foobar_ptr = unsafePerformIO hs_bindgen_f8e2e1e043022d0b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c0d2203c2008c671" hs_bindgen_c0d2203c2008c671_base :: BaseForeignType (IO (FunPtr (IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_core2_func_ptr@ +-} +hs_bindgen_c0d2203c2008c671 :: IO (FunPtr (IO CInt)) {-| __unique:__ @test_functionsfun_attributes_Example_get_core2_func_ptr@ -} -foreign import ccall safe "hs_bindgen_c0d2203c2008c671" hs_bindgen_c0d2203c2008c671 :: IO (FunPtr (IO CInt)) +hs_bindgen_c0d2203c2008c671 = fromBaseForeignType hs_bindgen_c0d2203c2008c671_base {-# NOINLINE core2_func_ptr #-} {-| __C declaration:__ @core2_func@ @@ -1293,9 +2006,15 @@ core2_func_ptr :: FunPtr (IO CInt) __exported by:__ @functions\/fun_attributes.h@ -} core2_func_ptr = unsafePerformIO hs_bindgen_c0d2203c2008c671 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0d9e6d9c675bc6c6" hs_bindgen_0d9e6d9c675bc6c6_base :: BaseForeignType (IO (FunPtr (IO CInt))) {-| __unique:__ @test_functionsfun_attributes_Example_get_sse3_func_ptr@ -} -foreign import ccall safe "hs_bindgen_0d9e6d9c675bc6c6" hs_bindgen_0d9e6d9c675bc6c6 :: IO (FunPtr (IO CInt)) +hs_bindgen_0d9e6d9c675bc6c6 :: IO (FunPtr (IO CInt)) +{-| __unique:__ @test_functionsfun_attributes_Example_get_sse3_func_ptr@ +-} +hs_bindgen_0d9e6d9c675bc6c6 = fromBaseForeignType hs_bindgen_0d9e6d9c675bc6c6_base {-# NOINLINE sse3_func_ptr #-} {-| __C declaration:__ @sse3_func@ @@ -1311,9 +2030,15 @@ sse3_func_ptr :: FunPtr (IO CInt) __exported by:__ @functions\/fun_attributes.h@ -} sse3_func_ptr = unsafePerformIO hs_bindgen_0d9e6d9c675bc6c6 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_83d5762c52905621" hs_bindgen_83d5762c52905621_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_f3_ptr@ +-} +hs_bindgen_83d5762c52905621 :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_functionsfun_attributes_Example_get_f3_ptr@ -} -foreign import ccall safe "hs_bindgen_83d5762c52905621" hs_bindgen_83d5762c52905621 :: IO (FunPtr (IO Unit)) +hs_bindgen_83d5762c52905621 = fromBaseForeignType hs_bindgen_83d5762c52905621_base {-# NOINLINE f3_ptr #-} {-| __C declaration:__ @f3@ @@ -1329,9 +2054,15 @@ f3_ptr :: FunPtr (IO Unit) __exported by:__ @functions\/fun_attributes.h@ -} f3_ptr = unsafePerformIO hs_bindgen_83d5762c52905621 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2c761cc9b4f8156d" hs_bindgen_2c761cc9b4f8156d_base :: BaseForeignType (IO (FunPtr (IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_fn_ptr@ +-} +hs_bindgen_2c761cc9b4f8156d :: IO (FunPtr (IO CInt)) {-| __unique:__ @test_functionsfun_attributes_Example_get_fn_ptr@ -} -foreign import ccall safe "hs_bindgen_2c761cc9b4f8156d" hs_bindgen_2c761cc9b4f8156d :: IO (FunPtr (IO CInt)) +hs_bindgen_2c761cc9b4f8156d = fromBaseForeignType hs_bindgen_2c761cc9b4f8156d_base {-# NOINLINE fn_ptr #-} {-| __C declaration:__ @fn@ @@ -1347,9 +2078,15 @@ fn_ptr :: FunPtr (IO CInt) __exported by:__ @functions\/fun_attributes.h@ -} fn_ptr = unsafePerformIO hs_bindgen_2c761cc9b4f8156d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a1175242bc62c1a1" hs_bindgen_a1175242bc62c1a1_base :: BaseForeignType (IO (FunPtr (IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_y_ptr@ +-} +hs_bindgen_a1175242bc62c1a1 :: IO (FunPtr (IO CInt)) {-| __unique:__ @test_functionsfun_attributes_Example_get_y_ptr@ -} -foreign import ccall safe "hs_bindgen_a1175242bc62c1a1" hs_bindgen_a1175242bc62c1a1 :: IO (FunPtr (IO CInt)) +hs_bindgen_a1175242bc62c1a1 = fromBaseForeignType hs_bindgen_a1175242bc62c1a1_base {-# NOINLINE y_ptr #-} {-| __C declaration:__ @y@ @@ -1365,9 +2102,15 @@ y_ptr :: FunPtr (IO CInt) __exported by:__ @functions\/fun_attributes.h@ -} y_ptr = unsafePerformIO hs_bindgen_a1175242bc62c1a1 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9ccc986739d1a164" hs_bindgen_9ccc986739d1a164_base :: BaseForeignType (IO (FunPtr (IO CInt))) {-| __unique:__ @test_functionsfun_attributes_Example_get_x1_ptr@ -} -foreign import ccall safe "hs_bindgen_9ccc986739d1a164" hs_bindgen_9ccc986739d1a164 :: IO (FunPtr (IO CInt)) +hs_bindgen_9ccc986739d1a164 :: IO (FunPtr (IO CInt)) +{-| __unique:__ @test_functionsfun_attributes_Example_get_x1_ptr@ +-} +hs_bindgen_9ccc986739d1a164 = fromBaseForeignType hs_bindgen_9ccc986739d1a164_base {-# NOINLINE x1_ptr #-} {-| __C declaration:__ @x1@ @@ -1383,9 +2126,15 @@ x1_ptr :: FunPtr (IO CInt) __exported by:__ @functions\/fun_attributes.h@ -} x1_ptr = unsafePerformIO hs_bindgen_9ccc986739d1a164 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8f44934a5928d386" hs_bindgen_8f44934a5928d386_base :: BaseForeignType (IO (FunPtr (IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_Example_get_x2_ptr@ +-} +hs_bindgen_8f44934a5928d386 :: IO (FunPtr (IO CInt)) {-| __unique:__ @test_functionsfun_attributes_Example_get_x2_ptr@ -} -foreign import ccall safe "hs_bindgen_8f44934a5928d386" hs_bindgen_8f44934a5928d386 :: IO (FunPtr (IO CInt)) +hs_bindgen_8f44934a5928d386 = fromBaseForeignType hs_bindgen_8f44934a5928d386_base {-# NOINLINE x2_ptr #-} {-| __C declaration:__ @x2@ @@ -1401,9 +2150,15 @@ x2_ptr :: FunPtr (IO CInt) __exported by:__ @functions\/fun_attributes.h@ -} x2_ptr = unsafePerformIO hs_bindgen_8f44934a5928d386 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ea890ba2b1b3e0a8" hs_bindgen_ea890ba2b1b3e0a8_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_functionsfun_attributes_Example_get_i_ptr@ +-} +hs_bindgen_ea890ba2b1b3e0a8 :: IO (Ptr CInt) {-| __unique:__ @test_functionsfun_attributes_Example_get_i_ptr@ -} -foreign import ccall safe "hs_bindgen_ea890ba2b1b3e0a8" hs_bindgen_ea890ba2b1b3e0a8 :: IO (Ptr CInt) +hs_bindgen_ea890ba2b1b3e0a8 = fromBaseForeignType hs_bindgen_ea890ba2b1b3e0a8_base {-# NOINLINE i_ptr #-} {-| __C declaration:__ @i@ diff --git a/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/FunPtr.hs b/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/FunPtr.hs index a2f02c45f..f79d3ec48 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -47,10 +48,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c7316eabb7ed43d1" hs_bindgen_c7316eabb7ed43d1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_cp_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c7316eabb7ed43d1" hs_bindgen_c7316eabb7ed43d1 :: +hs_bindgen_c7316eabb7ed43d1 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_c7316eabb7ed43d1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c7316eabb7ed43d1_base {-# NOINLINE square_cp_ptr #-} @@ -68,10 +76,17 @@ square_cp_ptr :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) square_cp_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c7316eabb7ed43d1 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_246016175c264c62" hs_bindgen_246016175c264c62_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_pc_ptr@ -} -foreign import ccall unsafe "hs_bindgen_246016175c264c62" hs_bindgen_246016175c264c62 :: +hs_bindgen_246016175c264c62 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_246016175c264c62 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_246016175c264c62_base {-# NOINLINE square_pc_ptr #-} @@ -85,10 +100,17 @@ square_pc_ptr :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) square_pc_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_246016175c264c62 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_927690360fc8e8ef" hs_bindgen_927690360fc8e8ef_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_cc_ptr@ -} -foreign import ccall unsafe "hs_bindgen_927690360fc8e8ef" hs_bindgen_927690360fc8e8ef :: +hs_bindgen_927690360fc8e8ef :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_927690360fc8e8ef = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_927690360fc8e8ef_base {-# NOINLINE square_cc_ptr #-} @@ -102,10 +124,17 @@ square_cc_ptr :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) square_cc_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_927690360fc8e8ef +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a7faaa7acbf26148" hs_bindgen_a7faaa7acbf26148_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_pp_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a7faaa7acbf26148" hs_bindgen_a7faaa7acbf26148 :: +hs_bindgen_a7faaa7acbf26148 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_a7faaa7acbf26148 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a7faaa7acbf26148_base {-# NOINLINE square_pp_ptr #-} diff --git a/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/Safe.hs b/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/Safe.hs index 3a2c5ed26..b12242e17 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/Safe.hs +++ b/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/Safe.hs @@ -6,6 +6,7 @@ module Example.Safe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -37,6 +38,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5d7162df3a16d8d5" square_cp_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) + {-| Conflicting attributes on functions for llvm/clang versions 18 and up Examples from https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html @@ -49,11 +55,18 @@ __exported by:__ @functions\/fun_attributes_conflict.h@ __unique:__ @test_functionsfun_attributes_confl_Example_Safe_square_cp@ -} -foreign import ccall safe "hs_bindgen_5d7162df3a16d8d5" square_cp :: +square_cp :: FC.CInt {- ^ __C declaration:__ @x@ -} -> FC.CInt +square_cp = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_cp_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7f240b4e0c2eea24" square_pc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) {-| __C declaration:__ @square_pc@ @@ -63,11 +76,18 @@ foreign import ccall safe "hs_bindgen_5d7162df3a16d8d5" square_cp :: __unique:__ @test_functionsfun_attributes_confl_Example_Safe_square_pc@ -} -foreign import ccall safe "hs_bindgen_7f240b4e0c2eea24" square_pc :: +square_pc :: FC.CInt {- ^ __C declaration:__ @x@ -} -> FC.CInt +square_pc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_pc_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d32b50f04af10764" square_cc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) {-| __C declaration:__ @square_cc@ @@ -77,11 +97,18 @@ foreign import ccall safe "hs_bindgen_7f240b4e0c2eea24" square_pc :: __unique:__ @test_functionsfun_attributes_confl_Example_Safe_square_cc@ -} -foreign import ccall safe "hs_bindgen_d32b50f04af10764" square_cc :: +square_cc :: FC.CInt {- ^ __C declaration:__ @x@ -} -> FC.CInt +square_cc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_cc_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fab6c9860ff1400b" square_pp_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) {-| @@ -95,8 +122,10 @@ __exported by:__ @functions\/fun_attributes_conflict.h@ __unique:__ @test_functionsfun_attributes_confl_Example_Safe_square_pp@ -} -foreign import ccall safe "hs_bindgen_fab6c9860ff1400b" square_pp :: +square_pp :: FC.CInt {- ^ __C declaration:__ @x@ -} -> IO FC.CInt +square_pp = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_pp_base diff --git a/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/Unsafe.hs b/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/Unsafe.hs index 6421bfc83..00b1b871e 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/functions/fun_attributes_conflict/Example/Unsafe.hs @@ -6,6 +6,7 @@ module Example.Unsafe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -37,6 +38,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_648d4f0fd0df4c79" square_cp_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) + {-| Conflicting attributes on functions for llvm/clang versions 18 and up Examples from https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html @@ -49,11 +55,18 @@ __exported by:__ @functions\/fun_attributes_conflict.h@ __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cp@ -} -foreign import ccall unsafe "hs_bindgen_648d4f0fd0df4c79" square_cp :: +square_cp :: FC.CInt {- ^ __C declaration:__ @x@ -} -> FC.CInt +square_cp = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_cp_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_632a1e6eb5ceeda7" square_pc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) {-| __C declaration:__ @square_pc@ @@ -63,11 +76,18 @@ foreign import ccall unsafe "hs_bindgen_648d4f0fd0df4c79" square_cp :: __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pc@ -} -foreign import ccall unsafe "hs_bindgen_632a1e6eb5ceeda7" square_pc :: +square_pc :: FC.CInt {- ^ __C declaration:__ @x@ -} -> FC.CInt +square_pc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_pc_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_56d75b1ff2482f13" square_cc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt) {-| __C declaration:__ @square_cc@ @@ -77,11 +97,18 @@ foreign import ccall unsafe "hs_bindgen_632a1e6eb5ceeda7" square_pc :: __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cc@ -} -foreign import ccall unsafe "hs_bindgen_56d75b1ff2482f13" square_cc :: +square_cc :: FC.CInt {- ^ __C declaration:__ @x@ -} -> FC.CInt +square_cc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_cc_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_eac2f9645ef29119" square_pp_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) {-| @@ -95,8 +122,10 @@ __exported by:__ @functions\/fun_attributes_conflict.h@ __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pp@ -} -foreign import ccall unsafe "hs_bindgen_eac2f9645ef29119" square_pp :: +square_pp :: FC.CInt {- ^ __C declaration:__ @x@ -} -> IO FC.CInt +square_pp = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_pp_base diff --git a/hs-bindgen/fixtures/functions/fun_attributes_conflict/th.txt b/hs-bindgen/fixtures/functions/fun_attributes_conflict/th.txt index f32f35fa7..49c075126 100644 --- a/hs-bindgen/fixtures/functions/fun_attributes_conflict/th.txt +++ b/hs-bindgen/fixtures/functions/fun_attributes_conflict/th.txt @@ -80,6 +80,23 @@ -- { -- return &square_pp; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5d7162df3a16d8d5" square_cp_base :: BaseForeignType (CInt -> + CInt) +{-| Conflicting attributes on functions for llvm/clang versions 18 and up + + Examples from https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html + +__C declaration:__ @square_cp@ + +__defined at:__ @functions\/fun_attributes_conflict.h:9:5@ + +__exported by:__ @functions\/fun_attributes_conflict.h@ + +__unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cp@ +-} +square_cp :: CInt -> CInt {-| Conflicting attributes on functions for llvm/clang versions 18 and up Examples from https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html @@ -92,8 +109,20 @@ __exported by:__ @functions\/fun_attributes_conflict.h@ __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cp@ -} -foreign import ccall safe "hs_bindgen_5d7162df3a16d8d5" square_cp :: CInt -> - CInt +square_cp = fromBaseForeignType square_cp_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7f240b4e0c2eea24" square_pc_base :: BaseForeignType (CInt -> + CInt) +{-| __C declaration:__ @square_pc@ + + __defined at:__ @functions\/fun_attributes_conflict.h:11:5@ + + __exported by:__ @functions\/fun_attributes_conflict.h@ + + __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pc@ +-} +square_pc :: CInt -> CInt {-| __C declaration:__ @square_pc@ __defined at:__ @functions\/fun_attributes_conflict.h:11:5@ @@ -102,8 +131,20 @@ foreign import ccall safe "hs_bindgen_5d7162df3a16d8d5" square_cp :: CInt -> __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pc@ -} -foreign import ccall safe "hs_bindgen_7f240b4e0c2eea24" square_pc :: CInt -> - CInt +square_pc = fromBaseForeignType square_pc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d32b50f04af10764" square_cc_base :: BaseForeignType (CInt -> + CInt) +{-| __C declaration:__ @square_cc@ + + __defined at:__ @functions\/fun_attributes_conflict.h:13:5@ + + __exported by:__ @functions\/fun_attributes_conflict.h@ + + __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cc@ +-} +square_cc :: CInt -> CInt {-| __C declaration:__ @square_cc@ __defined at:__ @functions\/fun_attributes_conflict.h:13:5@ @@ -112,8 +153,11 @@ foreign import ccall safe "hs_bindgen_7f240b4e0c2eea24" square_pc :: CInt -> __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cc@ -} -foreign import ccall safe "hs_bindgen_d32b50f04af10764" square_cc :: CInt -> - CInt +square_cc = fromBaseForeignType square_cc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fab6c9860ff1400b" square_pp_base :: BaseForeignType (CInt -> + IO CInt) {-| Marked @__attribute((pure))__@ @@ -126,8 +170,37 @@ __exported by:__ @functions\/fun_attributes_conflict.h@ __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pp@ -} -foreign import ccall safe "hs_bindgen_fab6c9860ff1400b" square_pp :: CInt -> - IO CInt +square_pp :: CInt -> IO CInt +{-| + + Marked @__attribute((pure))__@ + +__C declaration:__ @square_pp@ + +__defined at:__ @functions\/fun_attributes_conflict.h:15:5@ + +__exported by:__ @functions\/fun_attributes_conflict.h@ + +__unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pp@ +-} +square_pp = fromBaseForeignType square_pp_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_648d4f0fd0df4c79" square_cp_base :: BaseForeignType (CInt -> + CInt) +{-| Conflicting attributes on functions for llvm/clang versions 18 and up + + Examples from https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html + +__C declaration:__ @square_cp@ + +__defined at:__ @functions\/fun_attributes_conflict.h:9:5@ + +__exported by:__ @functions\/fun_attributes_conflict.h@ + +__unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cp@ +-} +square_cp :: CInt -> CInt {-| Conflicting attributes on functions for llvm/clang versions 18 and up Examples from https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html @@ -140,8 +213,11 @@ __exported by:__ @functions\/fun_attributes_conflict.h@ __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cp@ -} -foreign import ccall safe "hs_bindgen_648d4f0fd0df4c79" square_cp :: CInt -> - CInt +square_cp = fromBaseForeignType square_cp_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_632a1e6eb5ceeda7" square_pc_base :: BaseForeignType (CInt -> + CInt) {-| __C declaration:__ @square_pc@ __defined at:__ @functions\/fun_attributes_conflict.h:11:5@ @@ -150,8 +226,29 @@ foreign import ccall safe "hs_bindgen_648d4f0fd0df4c79" square_cp :: CInt -> __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pc@ -} -foreign import ccall safe "hs_bindgen_632a1e6eb5ceeda7" square_pc :: CInt -> - CInt +square_pc :: CInt -> CInt +{-| __C declaration:__ @square_pc@ + + __defined at:__ @functions\/fun_attributes_conflict.h:11:5@ + + __exported by:__ @functions\/fun_attributes_conflict.h@ + + __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pc@ +-} +square_pc = fromBaseForeignType square_pc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_56d75b1ff2482f13" square_cc_base :: BaseForeignType (CInt -> + CInt) +{-| __C declaration:__ @square_cc@ + + __defined at:__ @functions\/fun_attributes_conflict.h:13:5@ + + __exported by:__ @functions\/fun_attributes_conflict.h@ + + __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cc@ +-} +square_cc :: CInt -> CInt {-| __C declaration:__ @square_cc@ __defined at:__ @functions\/fun_attributes_conflict.h:13:5@ @@ -160,8 +257,24 @@ foreign import ccall safe "hs_bindgen_632a1e6eb5ceeda7" square_pc :: CInt -> __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_cc@ -} -foreign import ccall safe "hs_bindgen_56d75b1ff2482f13" square_cc :: CInt -> - CInt +square_cc = fromBaseForeignType square_cc_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eac2f9645ef29119" square_pp_base :: BaseForeignType (CInt -> + IO CInt) +{-| + + Marked @__attribute((pure))__@ + +__C declaration:__ @square_pp@ + +__defined at:__ @functions\/fun_attributes_conflict.h:15:5@ + +__exported by:__ @functions\/fun_attributes_conflict.h@ + +__unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pp@ +-} +square_pp :: CInt -> IO CInt {-| Marked @__attribute((pure))__@ @@ -174,12 +287,17 @@ __exported by:__ @functions\/fun_attributes_conflict.h@ __unique:__ @test_functionsfun_attributes_confl_Example_Unsafe_square_pp@ -} -foreign import ccall safe "hs_bindgen_eac2f9645ef29119" square_pp :: CInt -> - IO CInt +square_pp = fromBaseForeignType square_pp_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c7316eabb7ed43d1" hs_bindgen_c7316eabb7ed43d1_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_cp_ptr@ +-} +hs_bindgen_c7316eabb7ed43d1 :: IO (FunPtr (CInt -> IO CInt)) {-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_cp_ptr@ -} -foreign import ccall safe "hs_bindgen_c7316eabb7ed43d1" hs_bindgen_c7316eabb7ed43d1 :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_c7316eabb7ed43d1 = fromBaseForeignType hs_bindgen_c7316eabb7ed43d1_base {-# NOINLINE square_cp_ptr #-} {-| Conflicting attributes on functions for llvm/clang versions 18 and up @@ -203,10 +321,16 @@ __defined at:__ @functions\/fun_attributes_conflict.h:9:5@ __exported by:__ @functions\/fun_attributes_conflict.h@ -} square_cp_ptr = unsafePerformIO hs_bindgen_c7316eabb7ed43d1 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_246016175c264c62" hs_bindgen_246016175c264c62_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_pc_ptr@ +-} +hs_bindgen_246016175c264c62 :: IO (FunPtr (CInt -> IO CInt)) {-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_pc_ptr@ -} -foreign import ccall safe "hs_bindgen_246016175c264c62" hs_bindgen_246016175c264c62 :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_246016175c264c62 = fromBaseForeignType hs_bindgen_246016175c264c62_base {-# NOINLINE square_pc_ptr #-} {-| __C declaration:__ @square_pc@ @@ -222,10 +346,16 @@ square_pc_ptr :: FunPtr (CInt -> IO CInt) __exported by:__ @functions\/fun_attributes_conflict.h@ -} square_pc_ptr = unsafePerformIO hs_bindgen_246016175c264c62 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_927690360fc8e8ef" hs_bindgen_927690360fc8e8ef_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_cc_ptr@ +-} +hs_bindgen_927690360fc8e8ef :: IO (FunPtr (CInt -> IO CInt)) {-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_cc_ptr@ -} -foreign import ccall safe "hs_bindgen_927690360fc8e8ef" hs_bindgen_927690360fc8e8ef :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_927690360fc8e8ef = fromBaseForeignType hs_bindgen_927690360fc8e8ef_base {-# NOINLINE square_cc_ptr #-} {-| __C declaration:__ @square_cc@ @@ -241,10 +371,16 @@ square_cc_ptr :: FunPtr (CInt -> IO CInt) __exported by:__ @functions\/fun_attributes_conflict.h@ -} square_cc_ptr = unsafePerformIO hs_bindgen_927690360fc8e8ef +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a7faaa7acbf26148" hs_bindgen_a7faaa7acbf26148_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) +{-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_pp_ptr@ +-} +hs_bindgen_a7faaa7acbf26148 :: IO (FunPtr (CInt -> IO CInt)) {-| __unique:__ @test_functionsfun_attributes_confl_Example_get_square_pp_ptr@ -} -foreign import ccall safe "hs_bindgen_a7faaa7acbf26148" hs_bindgen_a7faaa7acbf26148 :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_a7faaa7acbf26148 = fromBaseForeignType hs_bindgen_a7faaa7acbf26148_base {-# NOINLINE square_pp_ptr #-} {-| __C declaration:__ @square_pp@ diff --git a/hs-bindgen/fixtures/functions/simple_func/Example/FunPtr.hs b/hs-bindgen/fixtures/functions/simple_func/Example/FunPtr.hs index ade879feb..cd723c326 100644 --- a/hs-bindgen/fixtures/functions/simple_func/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/functions/simple_func/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -54,10 +55,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1308338f62c45845" hs_bindgen_1308338f62c45845_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CDouble -> IO FC.CDouble))) + {-| __unique:__ @test_functionssimple_func_Example_get_erf_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1308338f62c45845" hs_bindgen_1308338f62c45845 :: +hs_bindgen_1308338f62c45845 :: IO (Ptr.FunPtr (FC.CDouble -> IO FC.CDouble)) +hs_bindgen_1308338f62c45845 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1308338f62c45845_base {-# NOINLINE erf_ptr #-} @@ -71,10 +79,17 @@ erf_ptr :: Ptr.FunPtr (FC.CDouble -> IO FC.CDouble) erf_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1308338f62c45845 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_457f7d0956688086" hs_bindgen_457f7d0956688086_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CDouble -> FC.CDouble -> FC.CDouble -> IO FC.CDouble))) + {-| __unique:__ @test_functionssimple_func_Example_get_bad_fma_ptr@ -} -foreign import ccall unsafe "hs_bindgen_457f7d0956688086" hs_bindgen_457f7d0956688086 :: +hs_bindgen_457f7d0956688086 :: IO (Ptr.FunPtr (FC.CDouble -> FC.CDouble -> FC.CDouble -> IO FC.CDouble)) +hs_bindgen_457f7d0956688086 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_457f7d0956688086_base {-# NOINLINE bad_fma_ptr #-} @@ -88,10 +103,17 @@ bad_fma_ptr :: Ptr.FunPtr (FC.CDouble -> FC.CDouble -> FC.CDouble -> IO FC.CDoub bad_fma_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_457f7d0956688086 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_db204712b6d929ba" hs_bindgen_db204712b6d929ba_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_functionssimple_func_Example_get_no_args_ptr@ -} -foreign import ccall unsafe "hs_bindgen_db204712b6d929ba" hs_bindgen_db204712b6d929ba :: +hs_bindgen_db204712b6d929ba :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_db204712b6d929ba = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_db204712b6d929ba_base {-# NOINLINE no_args_ptr #-} @@ -105,10 +127,17 @@ no_args_ptr :: Ptr.FunPtr (IO ()) no_args_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_db204712b6d929ba +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d8fd245fa84413ae" hs_bindgen_d8fd245fa84413ae_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_functionssimple_func_Example_get_no_args_no_void_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d8fd245fa84413ae" hs_bindgen_d8fd245fa84413ae :: +hs_bindgen_d8fd245fa84413ae :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_d8fd245fa84413ae = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d8fd245fa84413ae_base {-# NOINLINE no_args_no_void_ptr #-} @@ -122,10 +151,17 @@ no_args_no_void_ptr :: Ptr.FunPtr (IO ()) no_args_no_void_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d8fd245fa84413ae +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8541b259788f68ad" hs_bindgen_8541b259788f68ad_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CChar -> FC.CDouble -> IO FC.CInt))) + {-| __unique:__ @test_functionssimple_func_Example_get_fun_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8541b259788f68ad" hs_bindgen_8541b259788f68ad :: +hs_bindgen_8541b259788f68ad :: IO (Ptr.FunPtr (FC.CChar -> FC.CDouble -> IO FC.CInt)) +hs_bindgen_8541b259788f68ad = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8541b259788f68ad_base {-# NOINLINE fun_ptr #-} diff --git a/hs-bindgen/fixtures/functions/simple_func/Example/Safe.hs b/hs-bindgen/fixtures/functions/simple_func/Example/Safe.hs index ba3824ea4..a29b2ebbb 100644 --- a/hs-bindgen/fixtures/functions/simple_func/Example/Safe.hs +++ b/hs-bindgen/fixtures/functions/simple_func/Example/Safe.hs @@ -6,6 +6,7 @@ module Example.Safe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -42,6 +43,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1c811bfb80de8f77" erf_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CDouble -> FC.CDouble) + {-| __C declaration:__ @erf@ __defined at:__ @functions\/simple_func.h:1:8@ @@ -50,11 +56,18 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_functionssimple_func_Example_Safe_erf@ -} -foreign import ccall safe "hs_bindgen_1c811bfb80de8f77" erf :: +erf :: FC.CDouble {- ^ __C declaration:__ @arg@ -} -> FC.CDouble +erf = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType erf_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_180022d3518c53bd" bad_fma_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CDouble -> FC.CDouble -> FC.CDouble -> IO FC.CDouble) {-| __C declaration:__ @bad_fma@ @@ -64,7 +77,7 @@ foreign import ccall safe "hs_bindgen_1c811bfb80de8f77" erf :: __unique:__ @test_functionssimple_func_Example_Safe_bad_fma@ -} -foreign import ccall safe "hs_bindgen_180022d3518c53bd" bad_fma :: +bad_fma :: FC.CDouble {- ^ __C declaration:__ @x@ -} @@ -75,6 +88,13 @@ foreign import ccall safe "hs_bindgen_180022d3518c53bd" bad_fma :: {- ^ __C declaration:__ @z@ -} -> IO FC.CDouble +bad_fma = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bad_fma_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d72558f6f977200c" no_args_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @no_args@ @@ -84,8 +104,15 @@ foreign import ccall safe "hs_bindgen_180022d3518c53bd" bad_fma :: __unique:__ @test_functionssimple_func_Example_Safe_no_args@ -} -foreign import ccall safe "hs_bindgen_d72558f6f977200c" no_args :: +no_args :: IO () +no_args = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType no_args_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d8523e2ccea5c7ba" no_args_no_void_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @no_args_no_void@ @@ -95,8 +122,15 @@ foreign import ccall safe "hs_bindgen_d72558f6f977200c" no_args :: __unique:__ @test_functionssimple_func_Example_Safe_no_args_no_void@ -} -foreign import ccall safe "hs_bindgen_d8523e2ccea5c7ba" no_args_no_void :: +no_args_no_void :: IO () +no_args_no_void = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType no_args_no_void_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_48cbd3cd1c6e874f" fun_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CChar -> FC.CDouble -> IO FC.CInt) {-| __C declaration:__ @fun@ @@ -106,7 +140,7 @@ foreign import ccall safe "hs_bindgen_d8523e2ccea5c7ba" no_args_no_void :: __unique:__ @test_functionssimple_func_Example_Safe_fun@ -} -foreign import ccall safe "hs_bindgen_48cbd3cd1c6e874f" fun :: +fun :: FC.CChar {- ^ __C declaration:__ @x@ -} @@ -114,3 +148,5 @@ foreign import ccall safe "hs_bindgen_48cbd3cd1c6e874f" fun :: {- ^ __C declaration:__ @y@ -} -> IO FC.CInt +fun = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_base diff --git a/hs-bindgen/fixtures/functions/simple_func/Example/Unsafe.hs b/hs-bindgen/fixtures/functions/simple_func/Example/Unsafe.hs index 5b30f8079..2fe572e83 100644 --- a/hs-bindgen/fixtures/functions/simple_func/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/functions/simple_func/Example/Unsafe.hs @@ -6,6 +6,7 @@ module Example.Unsafe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -42,6 +43,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_da5d889180d72efd" erf_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CDouble -> FC.CDouble) + {-| __C declaration:__ @erf@ __defined at:__ @functions\/simple_func.h:1:8@ @@ -50,11 +56,18 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_functionssimple_func_Example_Unsafe_erf@ -} -foreign import ccall unsafe "hs_bindgen_da5d889180d72efd" erf :: +erf :: FC.CDouble {- ^ __C declaration:__ @arg@ -} -> FC.CDouble +erf = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType erf_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d02f37accebc0cb3" bad_fma_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CDouble -> FC.CDouble -> FC.CDouble -> IO FC.CDouble) {-| __C declaration:__ @bad_fma@ @@ -64,7 +77,7 @@ foreign import ccall unsafe "hs_bindgen_da5d889180d72efd" erf :: __unique:__ @test_functionssimple_func_Example_Unsafe_bad_fma@ -} -foreign import ccall unsafe "hs_bindgen_d02f37accebc0cb3" bad_fma :: +bad_fma :: FC.CDouble {- ^ __C declaration:__ @x@ -} @@ -75,6 +88,13 @@ foreign import ccall unsafe "hs_bindgen_d02f37accebc0cb3" bad_fma :: {- ^ __C declaration:__ @z@ -} -> IO FC.CDouble +bad_fma = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bad_fma_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9ea56ae4fab9a418" no_args_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @no_args@ @@ -84,8 +104,15 @@ foreign import ccall unsafe "hs_bindgen_d02f37accebc0cb3" bad_fma :: __unique:__ @test_functionssimple_func_Example_Unsafe_no_args@ -} -foreign import ccall unsafe "hs_bindgen_9ea56ae4fab9a418" no_args :: +no_args :: IO () +no_args = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType no_args_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a3d1783059ec7820" no_args_no_void_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) {-| __C declaration:__ @no_args_no_void@ @@ -95,8 +122,15 @@ foreign import ccall unsafe "hs_bindgen_9ea56ae4fab9a418" no_args :: __unique:__ @test_functionssimple_func_Example_Unsafe_no_args_no_void@ -} -foreign import ccall unsafe "hs_bindgen_a3d1783059ec7820" no_args_no_void :: +no_args_no_void :: IO () +no_args_no_void = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType no_args_no_void_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_91392ef466aa34e7" fun_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CChar -> FC.CDouble -> IO FC.CInt) {-| __C declaration:__ @fun@ @@ -106,7 +140,7 @@ foreign import ccall unsafe "hs_bindgen_a3d1783059ec7820" no_args_no_void :: __unique:__ @test_functionssimple_func_Example_Unsafe_fun@ -} -foreign import ccall unsafe "hs_bindgen_91392ef466aa34e7" fun :: +fun :: FC.CChar {- ^ __C declaration:__ @x@ -} @@ -114,3 +148,5 @@ foreign import ccall unsafe "hs_bindgen_91392ef466aa34e7" fun :: {- ^ __C declaration:__ @y@ -} -> IO FC.CInt +fun = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun_base diff --git a/hs-bindgen/fixtures/functions/simple_func/th.txt b/hs-bindgen/fixtures/functions/simple_func/th.txt index 2f31ec312..2299d4333 100644 --- a/hs-bindgen/fixtures/functions/simple_func/th.txt +++ b/hs-bindgen/fixtures/functions/simple_func/th.txt @@ -97,6 +97,19 @@ -- { -- return &fun; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1c811bfb80de8f77" erf_base :: BaseForeignType (CDouble -> + CDouble) +{-| __C declaration:__ @erf@ + + __defined at:__ @functions\/simple_func.h:1:8@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_erf@ +-} +erf :: CDouble -> CDouble {-| __C declaration:__ @erf@ __defined at:__ @functions\/simple_func.h:1:8@ @@ -105,8 +118,13 @@ __unique:__ @test_functionssimple_func_Example_Unsafe_erf@ -} -foreign import ccall safe "hs_bindgen_1c811bfb80de8f77" erf :: CDouble -> - CDouble +erf = fromBaseForeignType erf_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_180022d3518c53bd" bad_fma_base :: BaseForeignType (CDouble -> + CDouble -> + CDouble -> + IO CDouble) {-| __C declaration:__ @bad_fma@ __defined at:__ @functions\/simple_func.h:3:22@ @@ -115,8 +133,28 @@ foreign import ccall safe "hs_bindgen_1c811bfb80de8f77" erf :: CDouble -> __unique:__ @test_functionssimple_func_Example_Unsafe_bad_fma@ -} -foreign import ccall safe "hs_bindgen_180022d3518c53bd" bad_fma :: CDouble -> - CDouble -> CDouble -> IO CDouble +bad_fma :: CDouble -> CDouble -> CDouble -> IO CDouble +{-| __C declaration:__ @bad_fma@ + + __defined at:__ @functions\/simple_func.h:3:22@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_bad_fma@ +-} +bad_fma = fromBaseForeignType bad_fma_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d72558f6f977200c" no_args_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @no_args@ + + __defined at:__ @functions\/simple_func.h:7:6@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_no_args@ +-} +no_args :: IO Unit {-| __C declaration:__ @no_args@ __defined at:__ @functions\/simple_func.h:7:6@ @@ -125,7 +163,10 @@ foreign import ccall safe "hs_bindgen_180022d3518c53bd" bad_fma :: CDouble -> __unique:__ @test_functionssimple_func_Example_Unsafe_no_args@ -} -foreign import ccall safe "hs_bindgen_d72558f6f977200c" no_args :: IO Unit +no_args = fromBaseForeignType no_args_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d8523e2ccea5c7ba" no_args_no_void_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @no_args_no_void@ __defined at:__ @functions\/simple_func.h:9:6@ @@ -134,7 +175,30 @@ foreign import ccall safe "hs_bindgen_d72558f6f977200c" no_args :: IO Unit __unique:__ @test_functionssimple_func_Example_Unsafe_no_args_no_void@ -} -foreign import ccall safe "hs_bindgen_d8523e2ccea5c7ba" no_args_no_void :: IO Unit +no_args_no_void :: IO Unit +{-| __C declaration:__ @no_args_no_void@ + + __defined at:__ @functions\/simple_func.h:9:6@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_no_args_no_void@ +-} +no_args_no_void = fromBaseForeignType no_args_no_void_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_48cbd3cd1c6e874f" fun_base :: BaseForeignType (CChar -> + CDouble -> + IO CInt) +{-| __C declaration:__ @fun@ + + __defined at:__ @functions\/simple_func.h:11:5@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_fun@ +-} +fun :: CChar -> CDouble -> IO CInt {-| __C declaration:__ @fun@ __defined at:__ @functions\/simple_func.h:11:5@ @@ -143,8 +207,11 @@ foreign import ccall safe "hs_bindgen_d8523e2ccea5c7ba" no_args_no_void :: IO Un __unique:__ @test_functionssimple_func_Example_Unsafe_fun@ -} -foreign import ccall safe "hs_bindgen_48cbd3cd1c6e874f" fun :: CChar -> - CDouble -> IO CInt +fun = fromBaseForeignType fun_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_da5d889180d72efd" erf_base :: BaseForeignType (CDouble -> + CDouble) {-| __C declaration:__ @erf@ __defined at:__ @functions\/simple_func.h:1:8@ @@ -153,8 +220,22 @@ foreign import ccall safe "hs_bindgen_48cbd3cd1c6e874f" fun :: CChar -> __unique:__ @test_functionssimple_func_Example_Unsafe_erf@ -} -foreign import ccall safe "hs_bindgen_da5d889180d72efd" erf :: CDouble -> - CDouble +erf :: CDouble -> CDouble +{-| __C declaration:__ @erf@ + + __defined at:__ @functions\/simple_func.h:1:8@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_erf@ +-} +erf = fromBaseForeignType erf_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d02f37accebc0cb3" bad_fma_base :: BaseForeignType (CDouble -> + CDouble -> + CDouble -> + IO CDouble) {-| __C declaration:__ @bad_fma@ __defined at:__ @functions\/simple_func.h:3:22@ @@ -163,8 +244,28 @@ foreign import ccall safe "hs_bindgen_da5d889180d72efd" erf :: CDouble -> __unique:__ @test_functionssimple_func_Example_Unsafe_bad_fma@ -} -foreign import ccall safe "hs_bindgen_d02f37accebc0cb3" bad_fma :: CDouble -> - CDouble -> CDouble -> IO CDouble +bad_fma :: CDouble -> CDouble -> CDouble -> IO CDouble +{-| __C declaration:__ @bad_fma@ + + __defined at:__ @functions\/simple_func.h:3:22@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_bad_fma@ +-} +bad_fma = fromBaseForeignType bad_fma_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9ea56ae4fab9a418" no_args_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @no_args@ + + __defined at:__ @functions\/simple_func.h:7:6@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_no_args@ +-} +no_args :: IO Unit {-| __C declaration:__ @no_args@ __defined at:__ @functions\/simple_func.h:7:6@ @@ -173,7 +274,19 @@ foreign import ccall safe "hs_bindgen_d02f37accebc0cb3" bad_fma :: CDouble -> __unique:__ @test_functionssimple_func_Example_Unsafe_no_args@ -} -foreign import ccall safe "hs_bindgen_9ea56ae4fab9a418" no_args :: IO Unit +no_args = fromBaseForeignType no_args_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a3d1783059ec7820" no_args_no_void_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @no_args_no_void@ + + __defined at:__ @functions\/simple_func.h:9:6@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_no_args_no_void@ +-} +no_args_no_void :: IO Unit {-| __C declaration:__ @no_args_no_void@ __defined at:__ @functions\/simple_func.h:9:6@ @@ -182,7 +295,12 @@ foreign import ccall safe "hs_bindgen_9ea56ae4fab9a418" no_args :: IO Unit __unique:__ @test_functionssimple_func_Example_Unsafe_no_args_no_void@ -} -foreign import ccall safe "hs_bindgen_a3d1783059ec7820" no_args_no_void :: IO Unit +no_args_no_void = fromBaseForeignType no_args_no_void_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_91392ef466aa34e7" fun_base :: BaseForeignType (CChar -> + CDouble -> + IO CInt) {-| __C declaration:__ @fun@ __defined at:__ @functions\/simple_func.h:11:5@ @@ -191,12 +309,26 @@ foreign import ccall safe "hs_bindgen_a3d1783059ec7820" no_args_no_void :: IO Un __unique:__ @test_functionssimple_func_Example_Unsafe_fun@ -} -foreign import ccall safe "hs_bindgen_91392ef466aa34e7" fun :: CChar -> - CDouble -> IO CInt +fun :: CChar -> CDouble -> IO CInt +{-| __C declaration:__ @fun@ + + __defined at:__ @functions\/simple_func.h:11:5@ + + __exported by:__ @functions\/simple_func.h@ + + __unique:__ @test_functionssimple_func_Example_Unsafe_fun@ +-} +fun = fromBaseForeignType fun_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1308338f62c45845" hs_bindgen_1308338f62c45845_base :: BaseForeignType (IO (FunPtr (CDouble -> + IO CDouble))) +{-| __unique:__ @test_functionssimple_func_Example_get_erf_ptr@ +-} +hs_bindgen_1308338f62c45845 :: IO (FunPtr (CDouble -> IO CDouble)) {-| __unique:__ @test_functionssimple_func_Example_get_erf_ptr@ -} -foreign import ccall safe "hs_bindgen_1308338f62c45845" hs_bindgen_1308338f62c45845 :: IO (FunPtr (CDouble -> - IO CDouble)) +hs_bindgen_1308338f62c45845 = fromBaseForeignType hs_bindgen_1308338f62c45845_base {-# NOINLINE erf_ptr #-} {-| __C declaration:__ @erf@ @@ -212,12 +344,19 @@ erf_ptr :: FunPtr (CDouble -> IO CDouble) __exported by:__ @functions\/simple_func.h@ -} erf_ptr = unsafePerformIO hs_bindgen_1308338f62c45845 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_457f7d0956688086" hs_bindgen_457f7d0956688086_base :: BaseForeignType (IO (FunPtr (CDouble -> + CDouble -> + CDouble -> + IO CDouble))) +{-| __unique:__ @test_functionssimple_func_Example_get_bad_fma_ptr@ +-} +hs_bindgen_457f7d0956688086 :: IO (FunPtr (CDouble -> + CDouble -> CDouble -> IO CDouble)) {-| __unique:__ @test_functionssimple_func_Example_get_bad_fma_ptr@ -} -foreign import ccall safe "hs_bindgen_457f7d0956688086" hs_bindgen_457f7d0956688086 :: IO (FunPtr (CDouble -> - CDouble -> - CDouble -> - IO CDouble)) +hs_bindgen_457f7d0956688086 = fromBaseForeignType hs_bindgen_457f7d0956688086_base {-# NOINLINE bad_fma_ptr #-} {-| __C declaration:__ @bad_fma@ @@ -233,9 +372,15 @@ bad_fma_ptr :: FunPtr (CDouble -> CDouble -> CDouble -> IO CDouble) __exported by:__ @functions\/simple_func.h@ -} bad_fma_ptr = unsafePerformIO hs_bindgen_457f7d0956688086 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_db204712b6d929ba" hs_bindgen_db204712b6d929ba_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_functionssimple_func_Example_get_no_args_ptr@ +-} +hs_bindgen_db204712b6d929ba :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_functionssimple_func_Example_get_no_args_ptr@ -} -foreign import ccall safe "hs_bindgen_db204712b6d929ba" hs_bindgen_db204712b6d929ba :: IO (FunPtr (IO Unit)) +hs_bindgen_db204712b6d929ba = fromBaseForeignType hs_bindgen_db204712b6d929ba_base {-# NOINLINE no_args_ptr #-} {-| __C declaration:__ @no_args@ @@ -251,9 +396,15 @@ no_args_ptr :: FunPtr (IO Unit) __exported by:__ @functions\/simple_func.h@ -} no_args_ptr = unsafePerformIO hs_bindgen_db204712b6d929ba +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d8fd245fa84413ae" hs_bindgen_d8fd245fa84413ae_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_functionssimple_func_Example_get_no_args_no_void_ptr@ +-} +hs_bindgen_d8fd245fa84413ae :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_functionssimple_func_Example_get_no_args_no_void_ptr@ -} -foreign import ccall safe "hs_bindgen_d8fd245fa84413ae" hs_bindgen_d8fd245fa84413ae :: IO (FunPtr (IO Unit)) +hs_bindgen_d8fd245fa84413ae = fromBaseForeignType hs_bindgen_d8fd245fa84413ae_base {-# NOINLINE no_args_no_void_ptr #-} {-| __C declaration:__ @no_args_no_void@ @@ -269,11 +420,18 @@ no_args_no_void_ptr :: FunPtr (IO Unit) __exported by:__ @functions\/simple_func.h@ -} no_args_no_void_ptr = unsafePerformIO hs_bindgen_d8fd245fa84413ae +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8541b259788f68ad" hs_bindgen_8541b259788f68ad_base :: BaseForeignType (IO (FunPtr (CChar -> + CDouble -> + IO CInt))) +{-| __unique:__ @test_functionssimple_func_Example_get_fun_ptr@ +-} +hs_bindgen_8541b259788f68ad :: IO (FunPtr (CChar -> + CDouble -> IO CInt)) {-| __unique:__ @test_functionssimple_func_Example_get_fun_ptr@ -} -foreign import ccall safe "hs_bindgen_8541b259788f68ad" hs_bindgen_8541b259788f68ad :: IO (FunPtr (CChar -> - CDouble -> - IO CInt)) +hs_bindgen_8541b259788f68ad = fromBaseForeignType hs_bindgen_8541b259788f68ad_base {-# NOINLINE fun_ptr #-} {-| __C declaration:__ @fun@ diff --git a/hs-bindgen/fixtures/functions/varargs/Example/FunPtr.hs b/hs-bindgen/fixtures/functions/varargs/Example/FunPtr.hs index 4e5d0533a..ecf1750f6 100644 --- a/hs-bindgen/fixtures/functions/varargs/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/functions/varargs/Example/FunPtr.hs @@ -7,6 +7,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -20,10 +21,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1ee4c98815eaff8a" hs_bindgen_1ee4c98815eaff8a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO ()))) + {-| __unique:__ @test_functionsvarargs_Example_get_h_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1ee4c98815eaff8a" hs_bindgen_1ee4c98815eaff8a :: +hs_bindgen_1ee4c98815eaff8a :: IO (Ptr.FunPtr (IO ())) +hs_bindgen_1ee4c98815eaff8a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1ee4c98815eaff8a_base {-# NOINLINE h_ptr #-} diff --git a/hs-bindgen/fixtures/functions/varargs/Example/Safe.hs b/hs-bindgen/fixtures/functions/varargs/Example/Safe.hs index 551c38a2c..871f4d408 100644 --- a/hs-bindgen/fixtures/functions/varargs/Example/Safe.hs +++ b/hs-bindgen/fixtures/functions/varargs/Example/Safe.hs @@ -5,6 +5,7 @@ module Example.Safe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -16,6 +17,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_77a4bac5bbe80f62" h_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @h@ __defined at:__ @functions\/varargs.h:8:6@ @@ -24,5 +30,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_functionsvarargs_Example_Safe_h@ -} -foreign import ccall safe "hs_bindgen_77a4bac5bbe80f62" h :: +h :: IO () +h = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType h_base diff --git a/hs-bindgen/fixtures/functions/varargs/Example/Unsafe.hs b/hs-bindgen/fixtures/functions/varargs/Example/Unsafe.hs index 11f385794..aed85fef7 100644 --- a/hs-bindgen/fixtures/functions/varargs/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/functions/varargs/Example/Unsafe.hs @@ -5,6 +5,7 @@ module Example.Unsafe where +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -16,6 +17,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_32ebae80cc3543e1" h_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO ()) + {-| __C declaration:__ @h@ __defined at:__ @functions\/varargs.h:8:6@ @@ -24,5 +30,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_functionsvarargs_Example_Unsafe_h@ -} -foreign import ccall unsafe "hs_bindgen_32ebae80cc3543e1" h :: +h :: IO () +h = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType h_base diff --git a/hs-bindgen/fixtures/functions/varargs/th.txt b/hs-bindgen/fixtures/functions/varargs/th.txt index d143f7b7e..ef5ad1b01 100644 --- a/hs-bindgen/fixtures/functions/varargs/th.txt +++ b/hs-bindgen/fixtures/functions/varargs/th.txt @@ -16,6 +16,9 @@ -- { -- return &h; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_77a4bac5bbe80f62" h_base :: BaseForeignType (IO Unit) {-| __C declaration:__ @h@ __defined at:__ @functions\/varargs.h:8:6@ @@ -24,7 +27,7 @@ __unique:__ @test_functionsvarargs_Example_Unsafe_h@ -} -foreign import ccall safe "hs_bindgen_77a4bac5bbe80f62" h :: IO Unit +h :: IO Unit {-| __C declaration:__ @h@ __defined at:__ @functions\/varargs.h:8:6@ @@ -33,10 +36,37 @@ foreign import ccall safe "hs_bindgen_77a4bac5bbe80f62" h :: IO Unit __unique:__ @test_functionsvarargs_Example_Unsafe_h@ -} -foreign import ccall safe "hs_bindgen_32ebae80cc3543e1" h :: IO Unit +h = fromBaseForeignType h_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_32ebae80cc3543e1" h_base :: BaseForeignType (IO Unit) +{-| __C declaration:__ @h@ + + __defined at:__ @functions\/varargs.h:8:6@ + + __exported by:__ @functions\/varargs.h@ + + __unique:__ @test_functionsvarargs_Example_Unsafe_h@ +-} +h :: IO Unit +{-| __C declaration:__ @h@ + + __defined at:__ @functions\/varargs.h:8:6@ + + __exported by:__ @functions\/varargs.h@ + + __unique:__ @test_functionsvarargs_Example_Unsafe_h@ +-} +h = fromBaseForeignType h_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1ee4c98815eaff8a" hs_bindgen_1ee4c98815eaff8a_base :: BaseForeignType (IO (FunPtr (IO Unit))) +{-| __unique:__ @test_functionsvarargs_Example_get_h_ptr@ +-} +hs_bindgen_1ee4c98815eaff8a :: IO (FunPtr (IO Unit)) {-| __unique:__ @test_functionsvarargs_Example_get_h_ptr@ -} -foreign import ccall safe "hs_bindgen_1ee4c98815eaff8a" hs_bindgen_1ee4c98815eaff8a :: IO (FunPtr (IO Unit)) +hs_bindgen_1ee4c98815eaff8a = fromBaseForeignType hs_bindgen_1ee4c98815eaff8a_base {-# NOINLINE h_ptr #-} {-| __C declaration:__ @h@ diff --git a/hs-bindgen/fixtures/globals/globals/Example/Global.hs b/hs-bindgen/fixtures/globals/globals/Example/Global.hs index 9015a9855..9842b1847 100644 --- a/hs-bindgen/fixtures/globals/globals/Example/Global.hs +++ b/hs-bindgen/fixtures/globals/globals/Example/Global.hs @@ -11,6 +11,7 @@ import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -199,10 +200,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_714e2053c32bb476" hs_bindgen_714e2053c32bb476_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_globalsglobals_Example_get_simpleGlobal_ptr@ -} -foreign import ccall unsafe "hs_bindgen_714e2053c32bb476" hs_bindgen_714e2053c32bb476 :: +hs_bindgen_714e2053c32bb476 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_714e2053c32bb476 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_714e2053c32bb476_base {-# NOINLINE simpleGlobal_ptr #-} @@ -218,10 +226,17 @@ simpleGlobal_ptr :: Ptr.Ptr FC.CInt simpleGlobal_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_714e2053c32bb476 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_67e48c5e13ca2c60" hs_bindgen_67e48c5e13ca2c60_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Config)) + {-| __unique:__ @test_globalsglobals_Example_get_compoundGlobal1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_67e48c5e13ca2c60" hs_bindgen_67e48c5e13ca2c60 :: +hs_bindgen_67e48c5e13ca2c60 :: IO (Ptr.Ptr Config) +hs_bindgen_67e48c5e13ca2c60 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_67e48c5e13ca2c60_base {-# NOINLINE compoundGlobal1_ptr #-} @@ -235,10 +250,17 @@ compoundGlobal1_ptr :: Ptr.Ptr Config compoundGlobal1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_67e48c5e13ca2c60 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f26f5d6ef3b76089" hs_bindgen_f26f5d6ef3b76089_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Inline_struct)) + {-| __unique:__ @test_globalsglobals_Example_get_compoundGlobal2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f26f5d6ef3b76089" hs_bindgen_f26f5d6ef3b76089 :: +hs_bindgen_f26f5d6ef3b76089 :: IO (Ptr.Ptr Inline_struct) +hs_bindgen_f26f5d6ef3b76089 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f26f5d6ef3b76089_base {-# NOINLINE compoundGlobal2_ptr #-} @@ -252,10 +274,17 @@ compoundGlobal2_ptr :: Ptr.Ptr Inline_struct compoundGlobal2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f26f5d6ef3b76089 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3ebebd14325934b9" hs_bindgen_3ebebd14325934b9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_globalsglobals_Example_get_nesInteger_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3ebebd14325934b9" hs_bindgen_3ebebd14325934b9 :: +hs_bindgen_3ebebd14325934b9 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_3ebebd14325934b9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3ebebd14325934b9_base {-# NOINLINE nesInteger_ptr #-} @@ -277,10 +306,17 @@ nesInteger_ptr :: Ptr.Ptr FC.CInt nesInteger_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3ebebd14325934b9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_10b443be437175ac" hs_bindgen_10b443be437175ac_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CFloat)) + {-| __unique:__ @test_globalsglobals_Example_get_nesFloating_ptr@ -} -foreign import ccall unsafe "hs_bindgen_10b443be437175ac" hs_bindgen_10b443be437175ac :: +hs_bindgen_10b443be437175ac :: IO (Ptr.Ptr FC.CFloat) +hs_bindgen_10b443be437175ac = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_10b443be437175ac_base {-# NOINLINE nesFloating_ptr #-} @@ -294,10 +330,17 @@ nesFloating_ptr :: Ptr.Ptr FC.CFloat nesFloating_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_10b443be437175ac +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5cc8248fbb1c759a" hs_bindgen_5cc8248fbb1c759a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.Ptr FC.CChar))) + {-| __unique:__ @test_globalsglobals_Example_get_nesString1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_5cc8248fbb1c759a" hs_bindgen_5cc8248fbb1c759a :: +hs_bindgen_5cc8248fbb1c759a :: IO (Ptr.Ptr (Ptr.Ptr FC.CChar)) +hs_bindgen_5cc8248fbb1c759a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_5cc8248fbb1c759a_base {-# NOINLINE nesString1_ptr #-} @@ -311,10 +354,17 @@ nesString1_ptr :: Ptr.Ptr (Ptr.Ptr FC.CChar) nesString1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_5cc8248fbb1c759a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_553e972cf96f76d8" hs_bindgen_553e972cf96f76d8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CChar))) + {-| __unique:__ @test_globalsglobals_Example_get_nesString2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_553e972cf96f76d8" hs_bindgen_553e972cf96f76d8 :: +hs_bindgen_553e972cf96f76d8 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CChar)) +hs_bindgen_553e972cf96f76d8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_553e972cf96f76d8_base {-# NOINLINE nesString2_ptr #-} @@ -328,10 +378,17 @@ nesString2_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC. nesString2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_553e972cf96f76d8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9d3773e854e51f24" hs_bindgen_9d3773e854e51f24_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CChar)) + {-| __unique:__ @test_globalsglobals_Example_get_nesCharacter_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9d3773e854e51f24" hs_bindgen_9d3773e854e51f24 :: +hs_bindgen_9d3773e854e51f24 :: IO (Ptr.Ptr FC.CChar) +hs_bindgen_9d3773e854e51f24 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9d3773e854e51f24_base {-# NOINLINE nesCharacter_ptr #-} @@ -345,10 +402,17 @@ nesCharacter_ptr :: Ptr.Ptr FC.CChar nesCharacter_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9d3773e854e51f24 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a453d5edd9071d44" hs_bindgen_a453d5edd9071d44_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_globalsglobals_Example_get_nesParen_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a453d5edd9071d44" hs_bindgen_a453d5edd9071d44 :: +hs_bindgen_a453d5edd9071d44 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_a453d5edd9071d44 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a453d5edd9071d44_base {-# NOINLINE nesParen_ptr #-} @@ -362,10 +426,17 @@ nesParen_ptr :: Ptr.Ptr FC.CInt nesParen_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a453d5edd9071d44 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bad560390cc25eb6" hs_bindgen_bad560390cc25eb6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_globalsglobals_Example_get_nesUnary_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bad560390cc25eb6" hs_bindgen_bad560390cc25eb6 :: +hs_bindgen_bad560390cc25eb6 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_bad560390cc25eb6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bad560390cc25eb6_base {-# NOINLINE nesUnary_ptr #-} @@ -379,10 +450,17 @@ nesUnary_ptr :: Ptr.Ptr FC.CInt nesUnary_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bad560390cc25eb6 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b27e845110f4bbec" hs_bindgen_b27e845110f4bbec_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_globalsglobals_Example_get_nesBinary_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b27e845110f4bbec" hs_bindgen_b27e845110f4bbec :: +hs_bindgen_b27e845110f4bbec :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_b27e845110f4bbec = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b27e845110f4bbec_base {-# NOINLINE nesBinary_ptr #-} @@ -396,10 +474,17 @@ nesBinary_ptr :: Ptr.Ptr FC.CInt nesBinary_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_b27e845110f4bbec +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_34b54bf36a1d379e" hs_bindgen_34b54bf36a1d379e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_globalsglobals_Example_get_nesConditional_ptr@ -} -foreign import ccall unsafe "hs_bindgen_34b54bf36a1d379e" hs_bindgen_34b54bf36a1d379e :: +hs_bindgen_34b54bf36a1d379e :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_34b54bf36a1d379e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_34b54bf36a1d379e_base {-# NOINLINE nesConditional_ptr #-} @@ -413,10 +498,17 @@ nesConditional_ptr :: Ptr.Ptr FC.CInt nesConditional_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_34b54bf36a1d379e +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c61f871f8564e025" hs_bindgen_c61f871f8564e025_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CFloat)) + {-| __unique:__ @test_globalsglobals_Example_get_nesCast_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c61f871f8564e025" hs_bindgen_c61f871f8564e025 :: +hs_bindgen_c61f871f8564e025 :: IO (Ptr.Ptr FC.CFloat) +hs_bindgen_c61f871f8564e025 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c61f871f8564e025_base {-# NOINLINE nesCast_ptr #-} @@ -430,10 +522,17 @@ nesCast_ptr :: Ptr.Ptr FC.CFloat nesCast_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c61f871f8564e025 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_048b3e5b4043e865" hs_bindgen_048b3e5b4043e865_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) + {-| __unique:__ @test_globalsglobals_Example_get_nesCompound_ptr@ -} -foreign import ccall unsafe "hs_bindgen_048b3e5b4043e865" hs_bindgen_048b3e5b4043e865 :: +hs_bindgen_048b3e5b4043e865 :: IO (Ptr.Ptr (Ptr.Ptr FC.CInt)) +hs_bindgen_048b3e5b4043e865 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_048b3e5b4043e865_base {-# NOINLINE nesCompound_ptr #-} @@ -447,10 +546,17 @@ nesCompound_ptr :: Ptr.Ptr (Ptr.Ptr FC.CInt) nesCompound_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_048b3e5b4043e865 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b38ff22e5052f65a" hs_bindgen_b38ff22e5052f65a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) HsBindgen.Runtime.Prelude.Word8))) + {-| __unique:__ @test_globalsglobals_Example_get_nesInitList_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b38ff22e5052f65a" hs_bindgen_b38ff22e5052f65a :: +hs_bindgen_b38ff22e5052f65a :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) HsBindgen.Runtime.Prelude.Word8)) +hs_bindgen_b38ff22e5052f65a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b38ff22e5052f65a_base {-# NOINLINE nesInitList_ptr #-} @@ -464,10 +570,17 @@ nesInitList_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) Hs nesInitList_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_b38ff22e5052f65a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b91bd5866e3f3d29" hs_bindgen_b91bd5866e3f3d29_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CBool)) + {-| __unique:__ @test_globalsglobals_Example_get_nesBool_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b91bd5866e3f3d29" hs_bindgen_b91bd5866e3f3d29 :: +hs_bindgen_b91bd5866e3f3d29 :: IO (Ptr.Ptr FC.CBool) +hs_bindgen_b91bd5866e3f3d29 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b91bd5866e3f3d29_base {-# NOINLINE nesBool_ptr #-} @@ -481,10 +594,17 @@ nesBool_ptr :: Ptr.Ptr FC.CBool nesBool_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_b91bd5866e3f3d29 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cc754e9476d41d9c" hs_bindgen_cc754e9476d41d9c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4096) HsBindgen.Runtime.Prelude.Word8))) + {-| __unique:__ @test_globalsglobals_Example_get_streamBinary_ptr@ -} -foreign import ccall unsafe "hs_bindgen_cc754e9476d41d9c" hs_bindgen_cc754e9476d41d9c :: +hs_bindgen_cc754e9476d41d9c :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4096) HsBindgen.Runtime.Prelude.Word8)) +hs_bindgen_cc754e9476d41d9c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_cc754e9476d41d9c_base {-# NOINLINE streamBinary_ptr #-} @@ -504,10 +624,17 @@ streamBinary_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4096 streamBinary_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_cc754e9476d41d9c +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_070dcbfed009198d" hs_bindgen_070dcbfed009198d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr HsBindgen.Runtime.Prelude.Word32)) + {-| __unique:__ @test_globalsglobals_Example_get_streamBinary_len_ptr@ -} -foreign import ccall unsafe "hs_bindgen_070dcbfed009198d" hs_bindgen_070dcbfed009198d :: +hs_bindgen_070dcbfed009198d :: IO (Ptr.Ptr HsBindgen.Runtime.Prelude.Word32) +hs_bindgen_070dcbfed009198d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_070dcbfed009198d_base {-# NOINLINE streamBinary_len_ptr #-} @@ -521,10 +648,17 @@ streamBinary_len_ptr :: Ptr.Ptr HsBindgen.Runtime.Prelude.Word32 streamBinary_len_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_070dcbfed009198d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_799ae43fda9906f5" hs_bindgen_799ae43fda9906f5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Struct2_t)) + {-| __unique:__ @test_globalsglobals_Example_get_some_global_struct_ptr@ -} -foreign import ccall unsafe "hs_bindgen_799ae43fda9906f5" hs_bindgen_799ae43fda9906f5 :: +hs_bindgen_799ae43fda9906f5 :: IO (Ptr.Ptr Struct2_t) +hs_bindgen_799ae43fda9906f5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_799ae43fda9906f5_base {-# NOINLINE some_global_struct_ptr #-} @@ -538,10 +672,17 @@ some_global_struct_ptr :: Ptr.Ptr Struct2_t some_global_struct_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_799ae43fda9906f5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8c2513f5f7e3236e" hs_bindgen_8c2513f5f7e3236e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_globalsglobals_Example_get_globalConstant_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8c2513f5f7e3236e" hs_bindgen_8c2513f5f7e3236e :: +hs_bindgen_8c2513f5f7e3236e :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_8c2513f5f7e3236e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8c2513f5f7e3236e_base {-# NOINLINE globalConstant_ptr #-} @@ -565,10 +706,17 @@ globalConstant :: FC.CInt globalConstant = GHC.IO.Unsafe.unsafePerformIO (F.peek globalConstant_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8123602967122676" hs_bindgen_8123602967122676_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ConstInt)) + {-| __unique:__ @test_globalsglobals_Example_get_anotherGlobalConstant_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8123602967122676" hs_bindgen_8123602967122676 :: +hs_bindgen_8123602967122676 :: IO (Ptr.Ptr ConstInt) +hs_bindgen_8123602967122676 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8123602967122676_base {-# NOINLINE anotherGlobalConstant_ptr #-} @@ -588,10 +736,17 @@ anotherGlobalConstant :: ConstInt anotherGlobalConstant = GHC.IO.Unsafe.unsafePerformIO (F.peek anotherGlobalConstant_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d04ef3b41afccd4c" hs_bindgen_d04ef3b41afccd4c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_globalsglobals_Example_get_staticConst_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d04ef3b41afccd4c" hs_bindgen_d04ef3b41afccd4c :: +hs_bindgen_d04ef3b41afccd4c :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_d04ef3b41afccd4c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d04ef3b41afccd4c_base {-# NOINLINE staticConst_ptr #-} @@ -615,10 +770,17 @@ staticConst :: FC.CInt staticConst = GHC.IO.Unsafe.unsafePerformIO (F.peek staticConst_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5d93bd707e83de07" hs_bindgen_5d93bd707e83de07_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_globalsglobals_Example_get_classless_ptr@ -} -foreign import ccall unsafe "hs_bindgen_5d93bd707e83de07" hs_bindgen_5d93bd707e83de07 :: +hs_bindgen_5d93bd707e83de07 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_5d93bd707e83de07 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_5d93bd707e83de07_base {-# NOINLINE classless_ptr #-} @@ -640,10 +802,17 @@ classless :: FC.CInt classless = GHC.IO.Unsafe.unsafePerformIO (F.peek classless_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7779e72b6ab72de1" hs_bindgen_7779e72b6ab72de1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) FC.CInt))) + {-| __unique:__ @test_globalsglobals_Example_get_constArray1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7779e72b6ab72de1" hs_bindgen_7779e72b6ab72de1 :: +hs_bindgen_7779e72b6ab72de1 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 4) FC.CInt)) +hs_bindgen_7779e72b6ab72de1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7779e72b6ab72de1_base {-# NOINLINE constArray1_ptr #-} @@ -665,10 +834,17 @@ constArray1 :: (HsBindgen.Runtime.ConstantArray.ConstantArray 4) FC.CInt constArray1 = GHC.IO.Unsafe.unsafePerformIO (F.peek constArray1_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fed813bd4083c3c5" hs_bindgen_fed813bd4083c3c5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ConstIntArray)) + {-| __unique:__ @test_globalsglobals_Example_get_constArray2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_fed813bd4083c3c5" hs_bindgen_fed813bd4083c3c5 :: +hs_bindgen_fed813bd4083c3c5 :: IO (Ptr.Ptr ConstIntArray) +hs_bindgen_fed813bd4083c3c5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_fed813bd4083c3c5_base {-# NOINLINE constArray2_ptr #-} @@ -682,10 +858,17 @@ constArray2_ptr :: Ptr.Ptr ConstIntArray constArray2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_fed813bd4083c3c5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_07cd8b2ac394e36c" hs_bindgen_07cd8b2ac394e36c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Tuple)) + {-| __unique:__ @test_globalsglobals_Example_get_constTuple_ptr@ -} -foreign import ccall unsafe "hs_bindgen_07cd8b2ac394e36c" hs_bindgen_07cd8b2ac394e36c :: +hs_bindgen_07cd8b2ac394e36c :: IO (Ptr.Ptr Tuple) +hs_bindgen_07cd8b2ac394e36c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_07cd8b2ac394e36c_base {-# NOINLINE constTuple_ptr #-} @@ -707,10 +890,17 @@ constTuple :: Tuple constTuple = GHC.IO.Unsafe.unsafePerformIO (F.peek constTuple_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d5ea9aa1a5cbcedb" hs_bindgen_d5ea9aa1a5cbcedb_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Tuple)) + {-| __unique:__ @test_globalsglobals_Example_get_nonConstTuple_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d5ea9aa1a5cbcedb" hs_bindgen_d5ea9aa1a5cbcedb :: +hs_bindgen_d5ea9aa1a5cbcedb :: IO (Ptr.Ptr Tuple) +hs_bindgen_d5ea9aa1a5cbcedb = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d5ea9aa1a5cbcedb_base {-# NOINLINE nonConstTuple_ptr #-} @@ -726,10 +916,17 @@ nonConstTuple_ptr :: Ptr.Ptr Tuple nonConstTuple_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d5ea9aa1a5cbcedb +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f167ac4f659d037d" hs_bindgen_f167ac4f659d037d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) + {-| __unique:__ @test_globalsglobals_Example_get_ptrToConstInt_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f167ac4f659d037d" hs_bindgen_f167ac4f659d037d :: +hs_bindgen_f167ac4f659d037d :: IO (Ptr.Ptr (Ptr.Ptr FC.CInt)) +hs_bindgen_f167ac4f659d037d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f167ac4f659d037d_base {-# NOINLINE ptrToConstInt_ptr #-} @@ -745,10 +942,17 @@ ptrToConstInt_ptr :: Ptr.Ptr (Ptr.Ptr FC.CInt) ptrToConstInt_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f167ac4f659d037d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8376621614875e3d" hs_bindgen_8376621614875e3d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) + {-| __unique:__ @test_globalsglobals_Example_get_constPtrToInt_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8376621614875e3d" hs_bindgen_8376621614875e3d :: +hs_bindgen_8376621614875e3d :: IO (Ptr.Ptr (Ptr.Ptr FC.CInt)) +hs_bindgen_8376621614875e3d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8376621614875e3d_base {-# NOINLINE constPtrToInt_ptr #-} @@ -770,10 +974,17 @@ constPtrToInt :: Ptr.Ptr FC.CInt constPtrToInt = GHC.IO.Unsafe.unsafePerformIO (F.peek constPtrToInt_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_afb4f6b5c6ec422e" hs_bindgen_afb4f6b5c6ec422e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) + {-| __unique:__ @test_globalsglobals_Example_get_constPtrToConstInt_ptr@ -} -foreign import ccall unsafe "hs_bindgen_afb4f6b5c6ec422e" hs_bindgen_afb4f6b5c6ec422e :: +hs_bindgen_afb4f6b5c6ec422e :: IO (Ptr.Ptr (Ptr.Ptr FC.CInt)) +hs_bindgen_afb4f6b5c6ec422e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_afb4f6b5c6ec422e_base {-# NOINLINE constPtrToConstInt_ptr #-} diff --git a/hs-bindgen/fixtures/globals/globals/th.txt b/hs-bindgen/fixtures/globals/globals/th.txt index 8ee85fd1d..0db345cf5 100644 --- a/hs-bindgen/fixtures/globals/globals/th.txt +++ b/hs-bindgen/fixtures/globals/globals/th.txt @@ -533,9 +533,15 @@ instance HasCField Tuple "tuple_y" instance TyEq ty (CFieldType Tuple "tuple_y") => HasField "tuple_y" (Ptr Tuple) (Ptr ty) where getField = ptrToCField (Proxy @"tuple_y") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_714e2053c32bb476" hs_bindgen_714e2053c32bb476_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_globalsglobals_Example_get_simpleGlobal_ptr@ +-} +hs_bindgen_714e2053c32bb476 :: IO (Ptr CInt) {-| __unique:__ @test_globalsglobals_Example_get_simpleGlobal_ptr@ -} -foreign import ccall safe "hs_bindgen_714e2053c32bb476" hs_bindgen_714e2053c32bb476 :: IO (Ptr CInt) +hs_bindgen_714e2053c32bb476 = fromBaseForeignType hs_bindgen_714e2053c32bb476_base {-# NOINLINE simpleGlobal_ptr #-} {-| Global variables @@ -555,9 +561,15 @@ __defined at:__ @globals\/globals.h:9:12@ __exported by:__ @globals\/globals.h@ -} simpleGlobal_ptr = unsafePerformIO hs_bindgen_714e2053c32bb476 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_67e48c5e13ca2c60" hs_bindgen_67e48c5e13ca2c60_base :: BaseForeignType (IO (Ptr Config)) +{-| __unique:__ @test_globalsglobals_Example_get_compoundGlobal1_ptr@ +-} +hs_bindgen_67e48c5e13ca2c60 :: IO (Ptr Config) {-| __unique:__ @test_globalsglobals_Example_get_compoundGlobal1_ptr@ -} -foreign import ccall safe "hs_bindgen_67e48c5e13ca2c60" hs_bindgen_67e48c5e13ca2c60 :: IO (Ptr Config) +hs_bindgen_67e48c5e13ca2c60 = fromBaseForeignType hs_bindgen_67e48c5e13ca2c60_base {-# NOINLINE compoundGlobal1_ptr #-} {-| __C declaration:__ @compoundGlobal1@ @@ -573,9 +585,15 @@ compoundGlobal1_ptr :: Ptr Config __exported by:__ @globals\/globals.h@ -} compoundGlobal1_ptr = unsafePerformIO hs_bindgen_67e48c5e13ca2c60 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f26f5d6ef3b76089" hs_bindgen_f26f5d6ef3b76089_base :: BaseForeignType (IO (Ptr Inline_struct)) +{-| __unique:__ @test_globalsglobals_Example_get_compoundGlobal2_ptr@ +-} +hs_bindgen_f26f5d6ef3b76089 :: IO (Ptr Inline_struct) {-| __unique:__ @test_globalsglobals_Example_get_compoundGlobal2_ptr@ -} -foreign import ccall safe "hs_bindgen_f26f5d6ef3b76089" hs_bindgen_f26f5d6ef3b76089 :: IO (Ptr Inline_struct) +hs_bindgen_f26f5d6ef3b76089 = fromBaseForeignType hs_bindgen_f26f5d6ef3b76089_base {-# NOINLINE compoundGlobal2_ptr #-} {-| __C declaration:__ @compoundGlobal2@ @@ -591,9 +609,15 @@ compoundGlobal2_ptr :: Ptr Inline_struct __exported by:__ @globals\/globals.h@ -} compoundGlobal2_ptr = unsafePerformIO hs_bindgen_f26f5d6ef3b76089 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3ebebd14325934b9" hs_bindgen_3ebebd14325934b9_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_globalsglobals_Example_get_nesInteger_ptr@ +-} +hs_bindgen_3ebebd14325934b9 :: IO (Ptr CInt) {-| __unique:__ @test_globalsglobals_Example_get_nesInteger_ptr@ -} -foreign import ccall safe "hs_bindgen_3ebebd14325934b9" hs_bindgen_3ebebd14325934b9 :: IO (Ptr CInt) +hs_bindgen_3ebebd14325934b9 = fromBaseForeignType hs_bindgen_3ebebd14325934b9_base {-# NOINLINE nesInteger_ptr #-} {-| Non-extern non-static global variables @@ -625,9 +649,15 @@ __defined at:__ @globals\/globals.h:35:9@ __exported by:__ @globals\/globals.h@ -} nesInteger_ptr = unsafePerformIO hs_bindgen_3ebebd14325934b9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_10b443be437175ac" hs_bindgen_10b443be437175ac_base :: BaseForeignType (IO (Ptr CFloat)) +{-| __unique:__ @test_globalsglobals_Example_get_nesFloating_ptr@ +-} +hs_bindgen_10b443be437175ac :: IO (Ptr CFloat) {-| __unique:__ @test_globalsglobals_Example_get_nesFloating_ptr@ -} -foreign import ccall safe "hs_bindgen_10b443be437175ac" hs_bindgen_10b443be437175ac :: IO (Ptr CFloat) +hs_bindgen_10b443be437175ac = fromBaseForeignType hs_bindgen_10b443be437175ac_base {-# NOINLINE nesFloating_ptr #-} {-| __C declaration:__ @nesFloating@ @@ -643,9 +673,15 @@ nesFloating_ptr :: Ptr CFloat __exported by:__ @globals\/globals.h@ -} nesFloating_ptr = unsafePerformIO hs_bindgen_10b443be437175ac +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5cc8248fbb1c759a" hs_bindgen_5cc8248fbb1c759a_base :: BaseForeignType (IO (Ptr (Ptr CChar))) +{-| __unique:__ @test_globalsglobals_Example_get_nesString1_ptr@ +-} +hs_bindgen_5cc8248fbb1c759a :: IO (Ptr (Ptr CChar)) {-| __unique:__ @test_globalsglobals_Example_get_nesString1_ptr@ -} -foreign import ccall safe "hs_bindgen_5cc8248fbb1c759a" hs_bindgen_5cc8248fbb1c759a :: IO (Ptr (Ptr CChar)) +hs_bindgen_5cc8248fbb1c759a = fromBaseForeignType hs_bindgen_5cc8248fbb1c759a_base {-# NOINLINE nesString1_ptr #-} {-| __C declaration:__ @nesString1@ @@ -661,10 +697,16 @@ nesString1_ptr :: Ptr (Ptr CChar) __exported by:__ @globals\/globals.h@ -} nesString1_ptr = unsafePerformIO hs_bindgen_5cc8248fbb1c759a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_553e972cf96f76d8" hs_bindgen_553e972cf96f76d8_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CChar))) +{-| __unique:__ @test_globalsglobals_Example_get_nesString2_ptr@ +-} +hs_bindgen_553e972cf96f76d8 :: IO (Ptr (ConstantArray 3 CChar)) {-| __unique:__ @test_globalsglobals_Example_get_nesString2_ptr@ -} -foreign import ccall safe "hs_bindgen_553e972cf96f76d8" hs_bindgen_553e972cf96f76d8 :: IO (Ptr (ConstantArray 3 - CChar)) +hs_bindgen_553e972cf96f76d8 = fromBaseForeignType hs_bindgen_553e972cf96f76d8_base {-# NOINLINE nesString2_ptr #-} {-| __C declaration:__ @nesString2@ @@ -680,9 +722,15 @@ nesString2_ptr :: Ptr (ConstantArray 3 CChar) __exported by:__ @globals\/globals.h@ -} nesString2_ptr = unsafePerformIO hs_bindgen_553e972cf96f76d8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9d3773e854e51f24" hs_bindgen_9d3773e854e51f24_base :: BaseForeignType (IO (Ptr CChar)) {-| __unique:__ @test_globalsglobals_Example_get_nesCharacter_ptr@ -} -foreign import ccall safe "hs_bindgen_9d3773e854e51f24" hs_bindgen_9d3773e854e51f24 :: IO (Ptr CChar) +hs_bindgen_9d3773e854e51f24 :: IO (Ptr CChar) +{-| __unique:__ @test_globalsglobals_Example_get_nesCharacter_ptr@ +-} +hs_bindgen_9d3773e854e51f24 = fromBaseForeignType hs_bindgen_9d3773e854e51f24_base {-# NOINLINE nesCharacter_ptr #-} {-| __C declaration:__ @nesCharacter@ @@ -698,9 +746,15 @@ nesCharacter_ptr :: Ptr CChar __exported by:__ @globals\/globals.h@ -} nesCharacter_ptr = unsafePerformIO hs_bindgen_9d3773e854e51f24 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a453d5edd9071d44" hs_bindgen_a453d5edd9071d44_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_globalsglobals_Example_get_nesParen_ptr@ +-} +hs_bindgen_a453d5edd9071d44 :: IO (Ptr CInt) {-| __unique:__ @test_globalsglobals_Example_get_nesParen_ptr@ -} -foreign import ccall safe "hs_bindgen_a453d5edd9071d44" hs_bindgen_a453d5edd9071d44 :: IO (Ptr CInt) +hs_bindgen_a453d5edd9071d44 = fromBaseForeignType hs_bindgen_a453d5edd9071d44_base {-# NOINLINE nesParen_ptr #-} {-| __C declaration:__ @nesParen@ @@ -716,9 +770,15 @@ nesParen_ptr :: Ptr CInt __exported by:__ @globals\/globals.h@ -} nesParen_ptr = unsafePerformIO hs_bindgen_a453d5edd9071d44 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bad560390cc25eb6" hs_bindgen_bad560390cc25eb6_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_globalsglobals_Example_get_nesUnary_ptr@ -} -foreign import ccall safe "hs_bindgen_bad560390cc25eb6" hs_bindgen_bad560390cc25eb6 :: IO (Ptr CInt) +hs_bindgen_bad560390cc25eb6 :: IO (Ptr CInt) +{-| __unique:__ @test_globalsglobals_Example_get_nesUnary_ptr@ +-} +hs_bindgen_bad560390cc25eb6 = fromBaseForeignType hs_bindgen_bad560390cc25eb6_base {-# NOINLINE nesUnary_ptr #-} {-| __C declaration:__ @nesUnary@ @@ -734,9 +794,15 @@ nesUnary_ptr :: Ptr CInt __exported by:__ @globals\/globals.h@ -} nesUnary_ptr = unsafePerformIO hs_bindgen_bad560390cc25eb6 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b27e845110f4bbec" hs_bindgen_b27e845110f4bbec_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_globalsglobals_Example_get_nesBinary_ptr@ -} -foreign import ccall safe "hs_bindgen_b27e845110f4bbec" hs_bindgen_b27e845110f4bbec :: IO (Ptr CInt) +hs_bindgen_b27e845110f4bbec :: IO (Ptr CInt) +{-| __unique:__ @test_globalsglobals_Example_get_nesBinary_ptr@ +-} +hs_bindgen_b27e845110f4bbec = fromBaseForeignType hs_bindgen_b27e845110f4bbec_base {-# NOINLINE nesBinary_ptr #-} {-| __C declaration:__ @nesBinary@ @@ -752,9 +818,15 @@ nesBinary_ptr :: Ptr CInt __exported by:__ @globals\/globals.h@ -} nesBinary_ptr = unsafePerformIO hs_bindgen_b27e845110f4bbec +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_34b54bf36a1d379e" hs_bindgen_34b54bf36a1d379e_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_globalsglobals_Example_get_nesConditional_ptr@ -} -foreign import ccall safe "hs_bindgen_34b54bf36a1d379e" hs_bindgen_34b54bf36a1d379e :: IO (Ptr CInt) +hs_bindgen_34b54bf36a1d379e :: IO (Ptr CInt) +{-| __unique:__ @test_globalsglobals_Example_get_nesConditional_ptr@ +-} +hs_bindgen_34b54bf36a1d379e = fromBaseForeignType hs_bindgen_34b54bf36a1d379e_base {-# NOINLINE nesConditional_ptr #-} {-| __C declaration:__ @nesConditional@ @@ -770,9 +842,15 @@ nesConditional_ptr :: Ptr CInt __exported by:__ @globals\/globals.h@ -} nesConditional_ptr = unsafePerformIO hs_bindgen_34b54bf36a1d379e +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c61f871f8564e025" hs_bindgen_c61f871f8564e025_base :: BaseForeignType (IO (Ptr CFloat)) {-| __unique:__ @test_globalsglobals_Example_get_nesCast_ptr@ -} -foreign import ccall safe "hs_bindgen_c61f871f8564e025" hs_bindgen_c61f871f8564e025 :: IO (Ptr CFloat) +hs_bindgen_c61f871f8564e025 :: IO (Ptr CFloat) +{-| __unique:__ @test_globalsglobals_Example_get_nesCast_ptr@ +-} +hs_bindgen_c61f871f8564e025 = fromBaseForeignType hs_bindgen_c61f871f8564e025_base {-# NOINLINE nesCast_ptr #-} {-| __C declaration:__ @nesCast@ @@ -788,9 +866,15 @@ nesCast_ptr :: Ptr CFloat __exported by:__ @globals\/globals.h@ -} nesCast_ptr = unsafePerformIO hs_bindgen_c61f871f8564e025 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_048b3e5b4043e865" hs_bindgen_048b3e5b4043e865_base :: BaseForeignType (IO (Ptr (Ptr CInt))) {-| __unique:__ @test_globalsglobals_Example_get_nesCompound_ptr@ -} -foreign import ccall safe "hs_bindgen_048b3e5b4043e865" hs_bindgen_048b3e5b4043e865 :: IO (Ptr (Ptr CInt)) +hs_bindgen_048b3e5b4043e865 :: IO (Ptr (Ptr CInt)) +{-| __unique:__ @test_globalsglobals_Example_get_nesCompound_ptr@ +-} +hs_bindgen_048b3e5b4043e865 = fromBaseForeignType hs_bindgen_048b3e5b4043e865_base {-# NOINLINE nesCompound_ptr #-} {-| __C declaration:__ @nesCompound@ @@ -806,10 +890,17 @@ nesCompound_ptr :: Ptr (Ptr CInt) __exported by:__ @globals\/globals.h@ -} nesCompound_ptr = unsafePerformIO hs_bindgen_048b3e5b4043e865 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b38ff22e5052f65a" hs_bindgen_b38ff22e5052f65a_base :: BaseForeignType (IO (Ptr (ConstantArray 4 + HsBindgen.Runtime.Prelude.Word8))) +{-| __unique:__ @test_globalsglobals_Example_get_nesInitList_ptr@ +-} +hs_bindgen_b38ff22e5052f65a :: IO (Ptr (ConstantArray 4 + HsBindgen.Runtime.Prelude.Word8)) {-| __unique:__ @test_globalsglobals_Example_get_nesInitList_ptr@ -} -foreign import ccall safe "hs_bindgen_b38ff22e5052f65a" hs_bindgen_b38ff22e5052f65a :: IO (Ptr (ConstantArray 4 - HsBindgen.Runtime.Prelude.Word8)) +hs_bindgen_b38ff22e5052f65a = fromBaseForeignType hs_bindgen_b38ff22e5052f65a_base {-# NOINLINE nesInitList_ptr #-} {-| __C declaration:__ @nesInitList@ @@ -826,9 +917,15 @@ nesInitList_ptr :: Ptr (ConstantArray 4 __exported by:__ @globals\/globals.h@ -} nesInitList_ptr = unsafePerformIO hs_bindgen_b38ff22e5052f65a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b91bd5866e3f3d29" hs_bindgen_b91bd5866e3f3d29_base :: BaseForeignType (IO (Ptr CBool)) +{-| __unique:__ @test_globalsglobals_Example_get_nesBool_ptr@ +-} +hs_bindgen_b91bd5866e3f3d29 :: IO (Ptr CBool) {-| __unique:__ @test_globalsglobals_Example_get_nesBool_ptr@ -} -foreign import ccall safe "hs_bindgen_b91bd5866e3f3d29" hs_bindgen_b91bd5866e3f3d29 :: IO (Ptr CBool) +hs_bindgen_b91bd5866e3f3d29 = fromBaseForeignType hs_bindgen_b91bd5866e3f3d29_base {-# NOINLINE nesBool_ptr #-} {-| __C declaration:__ @nesBool@ @@ -844,10 +941,17 @@ nesBool_ptr :: Ptr CBool __exported by:__ @globals\/globals.h@ -} nesBool_ptr = unsafePerformIO hs_bindgen_b91bd5866e3f3d29 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cc754e9476d41d9c" hs_bindgen_cc754e9476d41d9c_base :: BaseForeignType (IO (Ptr (ConstantArray 4096 + HsBindgen.Runtime.Prelude.Word8))) +{-| __unique:__ @test_globalsglobals_Example_get_streamBinary_ptr@ +-} +hs_bindgen_cc754e9476d41d9c :: IO (Ptr (ConstantArray 4096 + HsBindgen.Runtime.Prelude.Word8)) {-| __unique:__ @test_globalsglobals_Example_get_streamBinary_ptr@ -} -foreign import ccall safe "hs_bindgen_cc754e9476d41d9c" hs_bindgen_cc754e9476d41d9c :: IO (Ptr (ConstantArray 4096 - HsBindgen.Runtime.Prelude.Word8)) +hs_bindgen_cc754e9476d41d9c = fromBaseForeignType hs_bindgen_cc754e9476d41d9c_base {-# NOINLINE streamBinary_ptr #-} {-| Additional examples of global variables, abstracted from real examples @@ -876,9 +980,15 @@ __defined at:__ @globals\/globals.h:60:9@ __exported by:__ @globals\/globals.h@ -} streamBinary_ptr = unsafePerformIO hs_bindgen_cc754e9476d41d9c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_070dcbfed009198d" hs_bindgen_070dcbfed009198d_base :: BaseForeignType (IO (Ptr HsBindgen.Runtime.Prelude.Word32)) +{-| __unique:__ @test_globalsglobals_Example_get_streamBinary_len_ptr@ +-} +hs_bindgen_070dcbfed009198d :: IO (Ptr HsBindgen.Runtime.Prelude.Word32) {-| __unique:__ @test_globalsglobals_Example_get_streamBinary_len_ptr@ -} -foreign import ccall safe "hs_bindgen_070dcbfed009198d" hs_bindgen_070dcbfed009198d :: IO (Ptr HsBindgen.Runtime.Prelude.Word32) +hs_bindgen_070dcbfed009198d = fromBaseForeignType hs_bindgen_070dcbfed009198d_base {-# NOINLINE streamBinary_len_ptr #-} {-| __C declaration:__ @streamBinary_len@ @@ -894,9 +1004,15 @@ streamBinary_len_ptr :: Ptr HsBindgen.Runtime.Prelude.Word32 __exported by:__ @globals\/globals.h@ -} streamBinary_len_ptr = unsafePerformIO hs_bindgen_070dcbfed009198d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_799ae43fda9906f5" hs_bindgen_799ae43fda9906f5_base :: BaseForeignType (IO (Ptr Struct2_t)) +{-| __unique:__ @test_globalsglobals_Example_get_some_global_struct_ptr@ +-} +hs_bindgen_799ae43fda9906f5 :: IO (Ptr Struct2_t) {-| __unique:__ @test_globalsglobals_Example_get_some_global_struct_ptr@ -} -foreign import ccall safe "hs_bindgen_799ae43fda9906f5" hs_bindgen_799ae43fda9906f5 :: IO (Ptr Struct2_t) +hs_bindgen_799ae43fda9906f5 = fromBaseForeignType hs_bindgen_799ae43fda9906f5_base {-# NOINLINE some_global_struct_ptr #-} {-| __C declaration:__ @some_global_struct@ @@ -912,9 +1028,15 @@ some_global_struct_ptr :: Ptr Struct2_t __exported by:__ @globals\/globals.h@ -} some_global_struct_ptr = unsafePerformIO hs_bindgen_799ae43fda9906f5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8c2513f5f7e3236e" hs_bindgen_8c2513f5f7e3236e_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_globalsglobals_Example_get_globalConstant_ptr@ +-} +hs_bindgen_8c2513f5f7e3236e :: IO (Ptr CInt) {-| __unique:__ @test_globalsglobals_Example_get_globalConstant_ptr@ -} -foreign import ccall safe "hs_bindgen_8c2513f5f7e3236e" hs_bindgen_8c2513f5f7e3236e :: IO (Ptr CInt) +hs_bindgen_8c2513f5f7e3236e = fromBaseForeignType hs_bindgen_8c2513f5f7e3236e_base {-# NOINLINE globalConstant_ptr #-} {-| Constant @@ -941,9 +1063,15 @@ globalConstant_ptr = unsafePerformIO hs_bindgen_8c2513f5f7e3236e {-# NOINLINE globalConstant #-} globalConstant :: CInt globalConstant = unsafePerformIO (peek globalConstant_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8123602967122676" hs_bindgen_8123602967122676_base :: BaseForeignType (IO (Ptr ConstInt)) +{-| __unique:__ @test_globalsglobals_Example_get_anotherGlobalConstant_ptr@ +-} +hs_bindgen_8123602967122676 :: IO (Ptr ConstInt) {-| __unique:__ @test_globalsglobals_Example_get_anotherGlobalConstant_ptr@ -} -foreign import ccall safe "hs_bindgen_8123602967122676" hs_bindgen_8123602967122676 :: IO (Ptr ConstInt) +hs_bindgen_8123602967122676 = fromBaseForeignType hs_bindgen_8123602967122676_base {-# NOINLINE anotherGlobalConstant_ptr #-} {-| __C declaration:__ @anotherGlobalConstant@ @@ -962,9 +1090,15 @@ anotherGlobalConstant_ptr = unsafePerformIO hs_bindgen_8123602967122676 {-# NOINLINE anotherGlobalConstant #-} anotherGlobalConstant :: ConstInt anotherGlobalConstant = unsafePerformIO (peek anotherGlobalConstant_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d04ef3b41afccd4c" hs_bindgen_d04ef3b41afccd4c_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_globalsglobals_Example_get_staticConst_ptr@ +-} +hs_bindgen_d04ef3b41afccd4c :: IO (Ptr CInt) {-| __unique:__ @test_globalsglobals_Example_get_staticConst_ptr@ -} -foreign import ccall safe "hs_bindgen_d04ef3b41afccd4c" hs_bindgen_d04ef3b41afccd4c :: IO (Ptr CInt) +hs_bindgen_d04ef3b41afccd4c = fromBaseForeignType hs_bindgen_d04ef3b41afccd4c_base {-# NOINLINE staticConst_ptr #-} {-| Constant, but local to the file @@ -991,9 +1125,15 @@ staticConst_ptr = unsafePerformIO hs_bindgen_d04ef3b41afccd4c {-# NOINLINE staticConst #-} staticConst :: CInt staticConst = unsafePerformIO (peek staticConst_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5d93bd707e83de07" hs_bindgen_5d93bd707e83de07_base :: BaseForeignType (IO (Ptr CInt)) {-| __unique:__ @test_globalsglobals_Example_get_classless_ptr@ -} -foreign import ccall safe "hs_bindgen_5d93bd707e83de07" hs_bindgen_5d93bd707e83de07 :: IO (Ptr CInt) +hs_bindgen_5d93bd707e83de07 :: IO (Ptr CInt) +{-| __unique:__ @test_globalsglobals_Example_get_classless_ptr@ +-} +hs_bindgen_5d93bd707e83de07 = fromBaseForeignType hs_bindgen_5d93bd707e83de07_base {-# NOINLINE classless_ptr #-} {-| No storage class specified @@ -1016,10 +1156,16 @@ classless_ptr = unsafePerformIO hs_bindgen_5d93bd707e83de07 {-# NOINLINE classless #-} classless :: CInt classless = unsafePerformIO (peek classless_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7779e72b6ab72de1" hs_bindgen_7779e72b6ab72de1_base :: BaseForeignType (IO (Ptr (ConstantArray 4 + CInt))) +{-| __unique:__ @test_globalsglobals_Example_get_constArray1_ptr@ +-} +hs_bindgen_7779e72b6ab72de1 :: IO (Ptr (ConstantArray 4 CInt)) {-| __unique:__ @test_globalsglobals_Example_get_constArray1_ptr@ -} -foreign import ccall safe "hs_bindgen_7779e72b6ab72de1" hs_bindgen_7779e72b6ab72de1 :: IO (Ptr (ConstantArray 4 - CInt)) +hs_bindgen_7779e72b6ab72de1 = fromBaseForeignType hs_bindgen_7779e72b6ab72de1_base {-# NOINLINE constArray1_ptr #-} {-| A an array of size 4 containing constant integers @@ -1042,9 +1188,15 @@ constArray1_ptr = unsafePerformIO hs_bindgen_7779e72b6ab72de1 {-# NOINLINE constArray1 #-} constArray1 :: ConstantArray 4 CInt constArray1 = unsafePerformIO (peek constArray1_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fed813bd4083c3c5" hs_bindgen_fed813bd4083c3c5_base :: BaseForeignType (IO (Ptr ConstIntArray)) {-| __unique:__ @test_globalsglobals_Example_get_constArray2_ptr@ -} -foreign import ccall safe "hs_bindgen_fed813bd4083c3c5" hs_bindgen_fed813bd4083c3c5 :: IO (Ptr ConstIntArray) +hs_bindgen_fed813bd4083c3c5 :: IO (Ptr ConstIntArray) +{-| __unique:__ @test_globalsglobals_Example_get_constArray2_ptr@ +-} +hs_bindgen_fed813bd4083c3c5 = fromBaseForeignType hs_bindgen_fed813bd4083c3c5_base {-# NOINLINE constArray2_ptr #-} {-| __C declaration:__ @constArray2@ @@ -1060,9 +1212,15 @@ constArray2_ptr :: Ptr ConstIntArray __exported by:__ @globals\/globals.h@ -} constArray2_ptr = unsafePerformIO hs_bindgen_fed813bd4083c3c5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_07cd8b2ac394e36c" hs_bindgen_07cd8b2ac394e36c_base :: BaseForeignType (IO (Ptr Tuple)) {-| __unique:__ @test_globalsglobals_Example_get_constTuple_ptr@ -} -foreign import ccall safe "hs_bindgen_07cd8b2ac394e36c" hs_bindgen_07cd8b2ac394e36c :: IO (Ptr Tuple) +hs_bindgen_07cd8b2ac394e36c :: IO (Ptr Tuple) +{-| __unique:__ @test_globalsglobals_Example_get_constTuple_ptr@ +-} +hs_bindgen_07cd8b2ac394e36c = fromBaseForeignType hs_bindgen_07cd8b2ac394e36c_base {-# NOINLINE constTuple_ptr #-} {-| A constant tuple @@ -1085,9 +1243,15 @@ constTuple_ptr = unsafePerformIO hs_bindgen_07cd8b2ac394e36c {-# NOINLINE constTuple #-} constTuple :: Tuple constTuple = unsafePerformIO (peek constTuple_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d5ea9aa1a5cbcedb" hs_bindgen_d5ea9aa1a5cbcedb_base :: BaseForeignType (IO (Ptr Tuple)) {-| __unique:__ @test_globalsglobals_Example_get_nonConstTuple_ptr@ -} -foreign import ccall safe "hs_bindgen_d5ea9aa1a5cbcedb" hs_bindgen_d5ea9aa1a5cbcedb :: IO (Ptr Tuple) +hs_bindgen_d5ea9aa1a5cbcedb :: IO (Ptr Tuple) +{-| __unique:__ @test_globalsglobals_Example_get_nonConstTuple_ptr@ +-} +hs_bindgen_d5ea9aa1a5cbcedb = fromBaseForeignType hs_bindgen_d5ea9aa1a5cbcedb_base {-# NOINLINE nonConstTuple_ptr #-} {-| A non-constant tuple with a constant member @@ -1107,9 +1271,15 @@ __defined at:__ @globals\/globals.h:470:21@ __exported by:__ @globals\/globals.h@ -} nonConstTuple_ptr = unsafePerformIO hs_bindgen_d5ea9aa1a5cbcedb +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f167ac4f659d037d" hs_bindgen_f167ac4f659d037d_base :: BaseForeignType (IO (Ptr (Ptr CInt))) {-| __unique:__ @test_globalsglobals_Example_get_ptrToConstInt_ptr@ -} -foreign import ccall safe "hs_bindgen_f167ac4f659d037d" hs_bindgen_f167ac4f659d037d :: IO (Ptr (Ptr CInt)) +hs_bindgen_f167ac4f659d037d :: IO (Ptr (Ptr CInt)) +{-| __unique:__ @test_globalsglobals_Example_get_ptrToConstInt_ptr@ +-} +hs_bindgen_f167ac4f659d037d = fromBaseForeignType hs_bindgen_f167ac4f659d037d_base {-# NOINLINE ptrToConstInt_ptr #-} {-| A pointer to const int @@ -1129,9 +1299,15 @@ __defined at:__ @globals\/globals.h:473:20@ __exported by:__ @globals\/globals.h@ -} ptrToConstInt_ptr = unsafePerformIO hs_bindgen_f167ac4f659d037d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8376621614875e3d" hs_bindgen_8376621614875e3d_base :: BaseForeignType (IO (Ptr (Ptr CInt))) {-| __unique:__ @test_globalsglobals_Example_get_constPtrToInt_ptr@ -} -foreign import ccall safe "hs_bindgen_8376621614875e3d" hs_bindgen_8376621614875e3d :: IO (Ptr (Ptr CInt)) +hs_bindgen_8376621614875e3d :: IO (Ptr (Ptr CInt)) +{-| __unique:__ @test_globalsglobals_Example_get_constPtrToInt_ptr@ +-} +hs_bindgen_8376621614875e3d = fromBaseForeignType hs_bindgen_8376621614875e3d_base {-# NOINLINE constPtrToInt_ptr #-} {-| A const pointer to int @@ -1154,9 +1330,15 @@ constPtrToInt_ptr = unsafePerformIO hs_bindgen_8376621614875e3d {-# NOINLINE constPtrToInt #-} constPtrToInt :: Ptr CInt constPtrToInt = unsafePerformIO (peek constPtrToInt_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_afb4f6b5c6ec422e" hs_bindgen_afb4f6b5c6ec422e_base :: BaseForeignType (IO (Ptr (Ptr CInt))) +{-| __unique:__ @test_globalsglobals_Example_get_constPtrToConstInt_ptr@ +-} +hs_bindgen_afb4f6b5c6ec422e :: IO (Ptr (Ptr CInt)) {-| __unique:__ @test_globalsglobals_Example_get_constPtrToConstInt_ptr@ -} -foreign import ccall safe "hs_bindgen_afb4f6b5c6ec422e" hs_bindgen_afb4f6b5c6ec422e :: IO (Ptr (Ptr CInt)) +hs_bindgen_afb4f6b5c6ec422e = fromBaseForeignType hs_bindgen_afb4f6b5c6ec422e_base {-# NOINLINE constPtrToConstInt_ptr #-} {-| A const pointer to const int diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/FunPtr.hs b/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/FunPtr.hs index 2852f5849..c0b0c0aaf 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/FunPtr.hs @@ -10,6 +10,7 @@ import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -139,10 +140,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9ba032a8ddf22326" hs_bindgen_9ba032a8ddf22326_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (F -> FC.CChar -> IO FC.CChar))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_quux_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9ba032a8ddf22326" hs_bindgen_9ba032a8ddf22326 :: +hs_bindgen_9ba032a8ddf22326 :: IO (Ptr.FunPtr (F -> FC.CChar -> IO FC.CChar)) +hs_bindgen_9ba032a8ddf22326 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9ba032a8ddf22326_base {-# NOINLINE quux_ptr #-} @@ -156,10 +164,17 @@ quux_ptr :: Ptr.FunPtr (F -> FC.CChar -> IO FC.CChar) quux_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9ba032a8ddf22326 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dafcba2967781c8d" hs_bindgen_dafcba2967781c8d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CFloat -> (Ptr.Ptr C) -> IO (Ptr.Ptr C)))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_wam_ptr@ -} -foreign import ccall unsafe "hs_bindgen_dafcba2967781c8d" hs_bindgen_dafcba2967781c8d :: +hs_bindgen_dafcba2967781c8d :: IO (Ptr.FunPtr (FC.CFloat -> (Ptr.Ptr C) -> IO (Ptr.Ptr C))) +hs_bindgen_dafcba2967781c8d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_dafcba2967781c8d_base {-# NOINLINE wam_ptr #-} @@ -173,10 +188,17 @@ wam_ptr :: Ptr.FunPtr (FC.CFloat -> (Ptr.Ptr C) -> IO (Ptr.Ptr C)) wam_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_dafcba2967781c8d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_27ded2f560eadb5b" hs_bindgen_27ded2f560eadb5b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr FC.CChar)))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_foo1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_27ded2f560eadb5b" hs_bindgen_27ded2f560eadb5b :: +hs_bindgen_27ded2f560eadb5b :: IO (Ptr.FunPtr (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr FC.CChar))) +hs_bindgen_27ded2f560eadb5b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_27ded2f560eadb5b_base {-# NOINLINE foo1_ptr #-} @@ -190,10 +212,17 @@ foo1_ptr :: Ptr.FunPtr (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO foo1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_27ded2f560eadb5b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2f92fb3aace15650" hs_bindgen_2f92fb3aace15650_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (F -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr FC.CChar)))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_foo2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2f92fb3aace15650" hs_bindgen_2f92fb3aace15650 :: +hs_bindgen_2f92fb3aace15650 :: IO (Ptr.FunPtr (F -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr FC.CChar))) +hs_bindgen_2f92fb3aace15650 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2f92fb3aace15650_base {-# NOINLINE foo2_ptr #-} @@ -207,10 +236,17 @@ foo2_ptr :: Ptr.FunPtr (F -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr foo2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2f92fb3aace15650 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_06568a4cca591e6c" hs_bindgen_06568a4cca591e6c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr C)))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_foo3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_06568a4cca591e6c" hs_bindgen_06568a4cca591e6c :: +hs_bindgen_06568a4cca591e6c :: IO (Ptr.FunPtr (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr C))) +hs_bindgen_06568a4cca591e6c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_06568a4cca591e6c_base {-# NOINLINE foo3_ptr #-} @@ -224,10 +260,17 @@ foo3_ptr :: Ptr.FunPtr (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO foo3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_06568a4cca591e6c +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d9248136916656f7" hs_bindgen_d9248136916656f7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt))))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d9248136916656f7" hs_bindgen_d9248136916656f7 :: +hs_bindgen_d9248136916656f7 :: IO (Ptr.FunPtr (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt)))) +hs_bindgen_d9248136916656f7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d9248136916656f7_base {-# NOINLINE bar1_ptr #-} @@ -241,10 +284,17 @@ bar1_ptr :: Ptr.FunPtr (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt))) bar1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d9248136916656f7 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2638a77b200d9571" hs_bindgen_2638a77b200d9571_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (L -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt))))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2638a77b200d9571" hs_bindgen_2638a77b200d9571 :: +hs_bindgen_2638a77b200d9571 :: IO (Ptr.FunPtr (L -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt)))) +hs_bindgen_2638a77b200d9571 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2638a77b200d9571_base {-# NOINLINE bar2_ptr #-} @@ -258,10 +308,17 @@ bar2_ptr :: Ptr.FunPtr (L -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt))) bar2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2638a77b200d9571 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ebbd5d09631f1f45" hs_bindgen_ebbd5d09631f1f45_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CLong -> IO (Ptr.FunPtr (S -> IO FC.CInt))))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ebbd5d09631f1f45" hs_bindgen_ebbd5d09631f1f45 :: +hs_bindgen_ebbd5d09631f1f45 :: IO (Ptr.FunPtr (FC.CLong -> IO (Ptr.FunPtr (S -> IO FC.CInt)))) +hs_bindgen_ebbd5d09631f1f45 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ebbd5d09631f1f45_base {-# NOINLINE bar3_ptr #-} @@ -275,10 +332,17 @@ bar3_ptr :: Ptr.FunPtr (FC.CLong -> IO (Ptr.FunPtr (S -> IO FC.CInt))) bar3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_ebbd5d09631f1f45 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7082943a6d3dd96f" hs_bindgen_7082943a6d3dd96f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO I))))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7082943a6d3dd96f" hs_bindgen_7082943a6d3dd96f :: +hs_bindgen_7082943a6d3dd96f :: IO (Ptr.FunPtr (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO I)))) +hs_bindgen_7082943a6d3dd96f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7082943a6d3dd96f_base {-# NOINLINE bar4_ptr #-} @@ -292,10 +356,17 @@ bar4_ptr :: Ptr.FunPtr (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO I))) bar4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7082943a6d3dd96f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d13a2e48d313bb66" hs_bindgen_d13a2e48d313bb66_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_baz1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d13a2e48d313bb66" hs_bindgen_d13a2e48d313bb66 :: +hs_bindgen_d13a2e48d313bb66 :: IO (Ptr.FunPtr (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))))) +hs_bindgen_d13a2e48d313bb66 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d13a2e48d313bb66_base {-# NOINLINE baz1_ptr #-} @@ -309,10 +380,17 @@ baz1_ptr :: Ptr.FunPtr (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray baz1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d13a2e48d313bb66 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2e558de67f4f715d" hs_bindgen_2e558de67f4f715d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (I -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_baz2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2e558de67f4f715d" hs_bindgen_2e558de67f4f715d :: +hs_bindgen_2e558de67f4f715d :: IO (Ptr.FunPtr (I -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))))) +hs_bindgen_2e558de67f4f715d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2e558de67f4f715d_base {-# NOINLINE baz2_ptr #-} @@ -326,10 +404,17 @@ baz2_ptr :: Ptr.FunPtr (I -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.Const baz2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2e558de67f4f715d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7aba9db18419135a" hs_bindgen_7aba9db18419135a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) I)))))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_baz3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7aba9db18419135a" hs_bindgen_7aba9db18419135a :: +hs_bindgen_7aba9db18419135a :: IO (Ptr.FunPtr (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) I))))) +hs_bindgen_7aba9db18419135a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7aba9db18419135a_base {-# NOINLINE baz3_ptr #-} @@ -343,10 +428,17 @@ baz3_ptr :: Ptr.FunPtr (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray baz3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7aba9db18419135a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_35d1920cc9d86b63" hs_bindgen_35d1920cc9d86b63_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO I))) + {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_no_args_no_void_ptr@ -} -foreign import ccall unsafe "hs_bindgen_35d1920cc9d86b63" hs_bindgen_35d1920cc9d86b63 :: +hs_bindgen_35d1920cc9d86b63 :: IO (Ptr.FunPtr (IO I)) +hs_bindgen_35d1920cc9d86b63 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_35d1920cc9d86b63_base {-# NOINLINE no_args_no_void_ptr #-} diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/Safe.hs b/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/Safe.hs index 7667b588c..144f4dcc2 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/Safe.hs +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/Safe.hs @@ -9,6 +9,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -112,6 +113,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d345c332b6547629" quux_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (F -> FC.CChar -> IO FC.CChar) + {-| __C declaration:__ @quux@ __defined at:__ @macros\/macro_in_fundecl.h:12:6@ @@ -120,7 +126,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_quux@ -} -foreign import ccall safe "hs_bindgen_d345c332b6547629" quux :: +quux :: F {- ^ __C declaration:__ @x@ -} @@ -128,6 +134,13 @@ foreign import ccall safe "hs_bindgen_d345c332b6547629" quux :: {- ^ __C declaration:__ @y@ -} -> IO FC.CChar +quux = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType quux_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_195036c94aad554b" wam_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.Ptr C) -> IO (Ptr.Ptr C)) {-| __C declaration:__ @wam@ @@ -137,7 +150,7 @@ foreign import ccall safe "hs_bindgen_d345c332b6547629" quux :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_wam@ -} -foreign import ccall safe "hs_bindgen_195036c94aad554b" wam :: +wam :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -145,6 +158,13 @@ foreign import ccall safe "hs_bindgen_195036c94aad554b" wam :: {- ^ __C declaration:__ @y@ -} -> IO (Ptr.Ptr C) +wam = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType wam_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a40b504a8f7c1d11" foo1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr FC.CChar)) {-| __C declaration:__ @foo1@ @@ -154,7 +174,7 @@ foreign import ccall safe "hs_bindgen_195036c94aad554b" wam :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_foo1@ -} -foreign import ccall safe "hs_bindgen_a40b504a8f7c1d11" foo1 :: +foo1 :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -162,6 +182,13 @@ foreign import ccall safe "hs_bindgen_a40b504a8f7c1d11" foo1 :: {- ^ __C declaration:__ @g@ -} -> IO (Ptr.Ptr FC.CChar) +foo1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foo1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_83392129a2035c99" foo2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (F -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr FC.CChar)) {-| __C declaration:__ @foo2@ @@ -171,7 +198,7 @@ foreign import ccall safe "hs_bindgen_a40b504a8f7c1d11" foo1 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_foo2@ -} -foreign import ccall safe "hs_bindgen_83392129a2035c99" foo2 :: +foo2 :: F {- ^ __C declaration:__ @x@ -} @@ -179,6 +206,13 @@ foreign import ccall safe "hs_bindgen_83392129a2035c99" foo2 :: {- ^ __C declaration:__ @g@ -} -> IO (Ptr.Ptr FC.CChar) +foo2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foo2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0c7f4bce7905d355" foo3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr C)) {-| __C declaration:__ @foo3@ @@ -188,7 +222,7 @@ foreign import ccall safe "hs_bindgen_83392129a2035c99" foo2 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_foo3@ -} -foreign import ccall safe "hs_bindgen_0c7f4bce7905d355" foo3 :: +foo3 :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -196,6 +230,13 @@ foreign import ccall safe "hs_bindgen_0c7f4bce7905d355" foo3 :: {- ^ __C declaration:__ @g@ -} -> IO (Ptr.Ptr C) +foo3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foo3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3471ca0525deb2c0" bar1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt))) {-| __C declaration:__ @bar1@ @@ -205,11 +246,18 @@ foreign import ccall safe "hs_bindgen_0c7f4bce7905d355" foo3 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_bar1@ -} -foreign import ccall safe "hs_bindgen_3471ca0525deb2c0" bar1 :: +bar1 :: FC.CLong {- ^ __C declaration:__ @x@ -} -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt)) +bar1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bar1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d5a4af88f772ff72" bar2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (L -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt))) {-| __C declaration:__ @bar2@ @@ -219,11 +267,18 @@ foreign import ccall safe "hs_bindgen_3471ca0525deb2c0" bar1 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_bar2@ -} -foreign import ccall safe "hs_bindgen_d5a4af88f772ff72" bar2 :: +bar2 :: L {- ^ __C declaration:__ @x@ -} -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt)) +bar2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bar2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b289d62136acab77" bar3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CLong -> IO (Ptr.FunPtr (S -> IO FC.CInt))) {-| __C declaration:__ @bar3@ @@ -233,11 +288,18 @@ foreign import ccall safe "hs_bindgen_d5a4af88f772ff72" bar2 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_bar3@ -} -foreign import ccall safe "hs_bindgen_b289d62136acab77" bar3 :: +bar3 :: FC.CLong {- ^ __C declaration:__ @x@ -} -> IO (Ptr.FunPtr (S -> IO FC.CInt)) +bar3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bar3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2b5b36cf49f0e40e" bar4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO I))) {-| __C declaration:__ @bar4@ @@ -247,11 +309,18 @@ foreign import ccall safe "hs_bindgen_b289d62136acab77" bar3 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_bar4@ -} -foreign import ccall safe "hs_bindgen_2b5b36cf49f0e40e" bar4 :: +bar4 :: FC.CLong {- ^ __C declaration:__ @x@ -} -> IO (Ptr.FunPtr (FC.CShort -> IO I)) +bar4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bar4_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b56f5f3515f3cc33" baz1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) {-| __C declaration:__ @baz1@ @@ -261,11 +330,18 @@ foreign import ccall safe "hs_bindgen_2b5b36cf49f0e40e" bar4 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_baz1@ -} -foreign import ccall safe "hs_bindgen_b56f5f3515f3cc33" baz1 :: +baz1 :: FC.CInt {- ^ __C declaration:__ @i@ -} -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +baz1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType baz1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0b9b2e4d1699b6f3" baz2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (I -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) {-| __C declaration:__ @baz2@ @@ -275,11 +351,18 @@ foreign import ccall safe "hs_bindgen_b56f5f3515f3cc33" baz1 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_baz2@ -} -foreign import ccall safe "hs_bindgen_0b9b2e4d1699b6f3" baz2 :: +baz2 :: I {- ^ __C declaration:__ @i@ -} -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +baz2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType baz2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_459eabcbd019687c" baz3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) I)))) {-| __C declaration:__ @baz3@ @@ -289,11 +372,18 @@ foreign import ccall safe "hs_bindgen_0b9b2e4d1699b6f3" baz2 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_baz3@ -} -foreign import ccall safe "hs_bindgen_459eabcbd019687c" baz3 :: +baz3 :: FC.CInt {- ^ __C declaration:__ @i@ -} -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) I))) +baz3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType baz3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7ae4ab0ad4fb8cad" no_args_no_void_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO I) {-| __C declaration:__ @no_args_no_void@ @@ -303,5 +393,7 @@ foreign import ccall safe "hs_bindgen_459eabcbd019687c" baz3 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Safe_no_args_no_void@ -} -foreign import ccall safe "hs_bindgen_7ae4ab0ad4fb8cad" no_args_no_void :: +no_args_no_void :: IO I +no_args_no_void = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType no_args_no_void_base diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/Unsafe.hs b/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/Unsafe.hs index 762c5b2c7..a6da51b82 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl/Example/Unsafe.hs @@ -9,6 +9,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -112,6 +113,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ab9081efcd629826" quux_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (F -> FC.CChar -> IO FC.CChar) + {-| __C declaration:__ @quux@ __defined at:__ @macros\/macro_in_fundecl.h:12:6@ @@ -120,7 +126,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_quux@ -} -foreign import ccall unsafe "hs_bindgen_ab9081efcd629826" quux :: +quux :: F {- ^ __C declaration:__ @x@ -} @@ -128,6 +134,13 @@ foreign import ccall unsafe "hs_bindgen_ab9081efcd629826" quux :: {- ^ __C declaration:__ @y@ -} -> IO FC.CChar +quux = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType quux_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7db4d5f10d9904d8" wam_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.Ptr C) -> IO (Ptr.Ptr C)) {-| __C declaration:__ @wam@ @@ -137,7 +150,7 @@ foreign import ccall unsafe "hs_bindgen_ab9081efcd629826" quux :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_wam@ -} -foreign import ccall unsafe "hs_bindgen_7db4d5f10d9904d8" wam :: +wam :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -145,6 +158,13 @@ foreign import ccall unsafe "hs_bindgen_7db4d5f10d9904d8" wam :: {- ^ __C declaration:__ @y@ -} -> IO (Ptr.Ptr C) +wam = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType wam_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_18401e906d384fd5" foo1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr FC.CChar)) {-| __C declaration:__ @foo1@ @@ -154,7 +174,7 @@ foreign import ccall unsafe "hs_bindgen_7db4d5f10d9904d8" wam :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo1@ -} -foreign import ccall unsafe "hs_bindgen_18401e906d384fd5" foo1 :: +foo1 :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -162,6 +182,13 @@ foreign import ccall unsafe "hs_bindgen_18401e906d384fd5" foo1 :: {- ^ __C declaration:__ @g@ -} -> IO (Ptr.Ptr FC.CChar) +foo1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foo1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1e16ebe63a290ff6" foo2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (F -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr FC.CChar)) {-| __C declaration:__ @foo2@ @@ -171,7 +198,7 @@ foreign import ccall unsafe "hs_bindgen_18401e906d384fd5" foo1 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo2@ -} -foreign import ccall unsafe "hs_bindgen_1e16ebe63a290ff6" foo2 :: +foo2 :: F {- ^ __C declaration:__ @x@ -} @@ -179,6 +206,13 @@ foreign import ccall unsafe "hs_bindgen_1e16ebe63a290ff6" foo2 :: {- ^ __C declaration:__ @g@ -} -> IO (Ptr.Ptr FC.CChar) +foo2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foo2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_091043692da958ac" foo3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> IO (Ptr.Ptr C)) {-| __C declaration:__ @foo3@ @@ -188,7 +222,7 @@ foreign import ccall unsafe "hs_bindgen_1e16ebe63a290ff6" foo2 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo3@ -} -foreign import ccall unsafe "hs_bindgen_091043692da958ac" foo3 :: +foo3 :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -196,6 +230,13 @@ foreign import ccall unsafe "hs_bindgen_091043692da958ac" foo3 :: {- ^ __C declaration:__ @g@ -} -> IO (Ptr.Ptr C) +foo3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType foo3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cf4fa39c5b4ef431" bar1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt))) {-| __C declaration:__ @bar1@ @@ -205,11 +246,18 @@ foreign import ccall unsafe "hs_bindgen_091043692da958ac" foo3 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar1@ -} -foreign import ccall unsafe "hs_bindgen_cf4fa39c5b4ef431" bar1 :: +bar1 :: FC.CLong {- ^ __C declaration:__ @x@ -} -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt)) +bar1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bar1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9092ebfb46f7f31b" bar2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (L -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt))) {-| __C declaration:__ @bar2@ @@ -219,11 +267,18 @@ foreign import ccall unsafe "hs_bindgen_cf4fa39c5b4ef431" bar1 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar2@ -} -foreign import ccall unsafe "hs_bindgen_9092ebfb46f7f31b" bar2 :: +bar2 :: L {- ^ __C declaration:__ @x@ -} -> IO (Ptr.FunPtr (FC.CShort -> IO FC.CInt)) +bar2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bar2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a5e6607b472003eb" bar3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CLong -> IO (Ptr.FunPtr (S -> IO FC.CInt))) {-| __C declaration:__ @bar3@ @@ -233,11 +288,18 @@ foreign import ccall unsafe "hs_bindgen_9092ebfb46f7f31b" bar2 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar3@ -} -foreign import ccall unsafe "hs_bindgen_a5e6607b472003eb" bar3 :: +bar3 :: FC.CLong {- ^ __C declaration:__ @x@ -} -> IO (Ptr.FunPtr (S -> IO FC.CInt)) +bar3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bar3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_050bd8903c7b13dd" bar4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CLong -> IO (Ptr.FunPtr (FC.CShort -> IO I))) {-| __C declaration:__ @bar4@ @@ -247,11 +309,18 @@ foreign import ccall unsafe "hs_bindgen_a5e6607b472003eb" bar3 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar4@ -} -foreign import ccall unsafe "hs_bindgen_050bd8903c7b13dd" bar4 :: +bar4 :: FC.CLong {- ^ __C declaration:__ @x@ -} -> IO (Ptr.FunPtr (FC.CShort -> IO I)) +bar4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bar4_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f378b374e8c8c095" baz1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) {-| __C declaration:__ @baz1@ @@ -261,11 +330,18 @@ foreign import ccall unsafe "hs_bindgen_050bd8903c7b13dd" bar4 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz1@ -} -foreign import ccall unsafe "hs_bindgen_f378b374e8c8c095" baz1 :: +baz1 :: FC.CInt {- ^ __C declaration:__ @i@ -} -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +baz1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType baz1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_27cf571d08ac8c04" baz2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (I -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) {-| __C declaration:__ @baz2@ @@ -275,11 +351,18 @@ foreign import ccall unsafe "hs_bindgen_f378b374e8c8c095" baz1 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz2@ -} -foreign import ccall unsafe "hs_bindgen_27cf571d08ac8c04" baz2 :: +baz2 :: I {- ^ __C declaration:__ @i@ -} -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +baz2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType baz2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c4035ef23b908e27" baz3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) I)))) {-| __C declaration:__ @baz3@ @@ -289,11 +372,18 @@ foreign import ccall unsafe "hs_bindgen_27cf571d08ac8c04" baz2 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz3@ -} -foreign import ccall unsafe "hs_bindgen_c4035ef23b908e27" baz3 :: +baz3 :: FC.CInt {- ^ __C declaration:__ @i@ -} -> IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 2) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) I))) +baz3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType baz3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_77a9149f03b2767f" no_args_no_void_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO I) {-| __C declaration:__ @no_args_no_void@ @@ -303,5 +393,7 @@ foreign import ccall unsafe "hs_bindgen_c4035ef23b908e27" baz3 :: __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_no_args_no_void@ -} -foreign import ccall unsafe "hs_bindgen_77a9149f03b2767f" no_args_no_void :: +no_args_no_void :: IO I +no_args_no_void = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType no_args_no_void_base diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl/th.txt b/hs-bindgen/fixtures/macros/macro_in_fundecl/th.txt index 25b1f40c0..768b852d9 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl/th.txt +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl/th.txt @@ -463,6 +463,20 @@ instance ToFunPtr (S -> IO CInt) where toFunPtr = hs_bindgen_ffdbafa239adf14e instance FromFunPtr (S -> IO CInt) where fromFunPtr = hs_bindgen_9c8a77fe3560cebd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d345c332b6547629" quux_base :: BaseForeignType (F -> + CChar -> + IO CChar) +{-| __C declaration:__ @quux@ + + __defined at:__ @macros\/macro_in_fundecl.h:12:6@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_quux@ +-} +quux :: F -> CChar -> IO CChar {-| __C declaration:__ @quux@ __defined at:__ @macros\/macro_in_fundecl.h:12:6@ @@ -471,8 +485,21 @@ instance FromFunPtr (S -> IO CInt) __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_quux@ -} -foreign import ccall safe "hs_bindgen_d345c332b6547629" quux :: F -> - CChar -> IO CChar +quux = fromBaseForeignType quux_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_195036c94aad554b" wam_base :: BaseForeignType (CFloat -> + Ptr C -> + IO (Ptr C)) +{-| __C declaration:__ @wam@ + + __defined at:__ @macros\/macro_in_fundecl.h:13:4@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_wam@ +-} +wam :: CFloat -> Ptr C -> IO (Ptr C) {-| __C declaration:__ @wam@ __defined at:__ @macros\/macro_in_fundecl.h:13:4@ @@ -481,8 +508,22 @@ foreign import ccall safe "hs_bindgen_d345c332b6547629" quux :: F -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_wam@ -} -foreign import ccall safe "hs_bindgen_195036c94aad554b" wam :: CFloat -> - Ptr C -> IO (Ptr C) +wam = fromBaseForeignType wam_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a40b504a8f7c1d11" foo1_base :: BaseForeignType (CFloat -> + FunPtr (CInt -> + IO CInt) -> + IO (Ptr CChar)) +{-| __C declaration:__ @foo1@ + + __defined at:__ @macros\/macro_in_fundecl.h:16:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo1@ +-} +foo1 :: CFloat -> FunPtr (CInt -> IO CInt) -> IO (Ptr CChar) {-| __C declaration:__ @foo1@ __defined at:__ @macros\/macro_in_fundecl.h:16:7@ @@ -491,9 +532,13 @@ foreign import ccall safe "hs_bindgen_195036c94aad554b" wam :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo1@ -} -foreign import ccall safe "hs_bindgen_a40b504a8f7c1d11" foo1 :: CFloat -> - FunPtr (CInt -> IO CInt) -> - IO (Ptr CChar) +foo1 = fromBaseForeignType foo1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_83392129a2035c99" foo2_base :: BaseForeignType (F -> + FunPtr (CInt -> + IO CInt) -> + IO (Ptr CChar)) {-| __C declaration:__ @foo2@ __defined at:__ @macros\/macro_in_fundecl.h:17:7@ @@ -502,9 +547,22 @@ foreign import ccall safe "hs_bindgen_a40b504a8f7c1d11" foo1 :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo2@ -} -foreign import ccall safe "hs_bindgen_83392129a2035c99" foo2 :: F -> - FunPtr (CInt -> IO CInt) -> - IO (Ptr CChar) +foo2 :: F -> FunPtr (CInt -> IO CInt) -> IO (Ptr CChar) +{-| __C declaration:__ @foo2@ + + __defined at:__ @macros\/macro_in_fundecl.h:17:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo2@ +-} +foo2 = fromBaseForeignType foo2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0c7f4bce7905d355" foo3_base :: BaseForeignType (CFloat -> + FunPtr (CInt -> + IO CInt) -> + IO (Ptr C)) {-| __C declaration:__ @foo3@ __defined at:__ @macros\/macro_in_fundecl.h:18:4@ @@ -513,9 +571,30 @@ foreign import ccall safe "hs_bindgen_83392129a2035c99" foo2 :: F -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo3@ -} -foreign import ccall safe "hs_bindgen_0c7f4bce7905d355" foo3 :: CFloat -> - FunPtr (CInt -> IO CInt) -> - IO (Ptr C) +foo3 :: CFloat -> FunPtr (CInt -> IO CInt) -> IO (Ptr C) +{-| __C declaration:__ @foo3@ + + __defined at:__ @macros\/macro_in_fundecl.h:18:4@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo3@ +-} +foo3 = fromBaseForeignType foo3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3471ca0525deb2c0" bar1_base :: BaseForeignType (CLong -> + IO (FunPtr (CShort -> + IO CInt))) +{-| __C declaration:__ @bar1@ + + __defined at:__ @macros\/macro_in_fundecl.h:21:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar1@ +-} +bar1 :: CLong -> IO (FunPtr (CShort -> IO CInt)) {-| __C declaration:__ @bar1@ __defined at:__ @macros\/macro_in_fundecl.h:21:7@ @@ -524,8 +603,12 @@ foreign import ccall safe "hs_bindgen_0c7f4bce7905d355" foo3 :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar1@ -} -foreign import ccall safe "hs_bindgen_3471ca0525deb2c0" bar1 :: CLong -> - IO (FunPtr (CShort -> IO CInt)) +bar1 = fromBaseForeignType bar1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d5a4af88f772ff72" bar2_base :: BaseForeignType (L -> + IO (FunPtr (CShort -> + IO CInt))) {-| __C declaration:__ @bar2@ __defined at:__ @macros\/macro_in_fundecl.h:22:7@ @@ -534,8 +617,21 @@ foreign import ccall safe "hs_bindgen_3471ca0525deb2c0" bar1 :: CLong -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar2@ -} -foreign import ccall safe "hs_bindgen_d5a4af88f772ff72" bar2 :: L -> - IO (FunPtr (CShort -> IO CInt)) +bar2 :: L -> IO (FunPtr (CShort -> IO CInt)) +{-| __C declaration:__ @bar2@ + + __defined at:__ @macros\/macro_in_fundecl.h:22:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar2@ +-} +bar2 = fromBaseForeignType bar2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b289d62136acab77" bar3_base :: BaseForeignType (CLong -> + IO (FunPtr (S -> + IO CInt))) {-| __C declaration:__ @bar3@ __defined at:__ @macros\/macro_in_fundecl.h:23:7@ @@ -544,8 +640,21 @@ foreign import ccall safe "hs_bindgen_d5a4af88f772ff72" bar2 :: L -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar3@ -} -foreign import ccall safe "hs_bindgen_b289d62136acab77" bar3 :: CLong -> - IO (FunPtr (S -> IO CInt)) +bar3 :: CLong -> IO (FunPtr (S -> IO CInt)) +{-| __C declaration:__ @bar3@ + + __defined at:__ @macros\/macro_in_fundecl.h:23:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar3@ +-} +bar3 = fromBaseForeignType bar3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2b5b36cf49f0e40e" bar4_base :: BaseForeignType (CLong -> + IO (FunPtr (CShort -> + IO I))) {-| __C declaration:__ @bar4@ __defined at:__ @macros\/macro_in_fundecl.h:24:5@ @@ -554,8 +663,31 @@ foreign import ccall safe "hs_bindgen_b289d62136acab77" bar3 :: CLong -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar4@ -} -foreign import ccall safe "hs_bindgen_2b5b36cf49f0e40e" bar4 :: CLong -> - IO (FunPtr (CShort -> IO I)) +bar4 :: CLong -> IO (FunPtr (CShort -> IO I)) +{-| __C declaration:__ @bar4@ + + __defined at:__ @macros\/macro_in_fundecl.h:24:5@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar4@ +-} +bar4 = fromBaseForeignType bar4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b56f5f3515f3cc33" baz1_base :: BaseForeignType (CInt -> + IO (Ptr (ConstantArray 2 + (ConstantArray 3 + CInt)))) +{-| __C declaration:__ @baz1@ + + __defined at:__ @macros\/macro_in_fundecl.h:27:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz1@ +-} +baz1 :: CInt -> IO (Ptr (ConstantArray 2 (ConstantArray 3 CInt))) {-| __C declaration:__ @baz1@ __defined at:__ @macros\/macro_in_fundecl.h:27:7@ @@ -564,10 +696,13 @@ foreign import ccall safe "hs_bindgen_2b5b36cf49f0e40e" bar4 :: CLong -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz1@ -} -foreign import ccall safe "hs_bindgen_b56f5f3515f3cc33" baz1 :: CInt -> - IO (Ptr (ConstantArray 2 - (ConstantArray 3 - CInt))) +baz1 = fromBaseForeignType baz1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0b9b2e4d1699b6f3" baz2_base :: BaseForeignType (I -> + IO (Ptr (ConstantArray 2 + (ConstantArray 3 + CInt)))) {-| __C declaration:__ @baz2@ __defined at:__ @macros\/macro_in_fundecl.h:35:7@ @@ -576,10 +711,31 @@ foreign import ccall safe "hs_bindgen_b56f5f3515f3cc33" baz1 :: CInt -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz2@ -} -foreign import ccall safe "hs_bindgen_0b9b2e4d1699b6f3" baz2 :: I -> - IO (Ptr (ConstantArray 2 - (ConstantArray 3 - CInt))) +baz2 :: I -> IO (Ptr (ConstantArray 2 (ConstantArray 3 CInt))) +{-| __C declaration:__ @baz2@ + + __defined at:__ @macros\/macro_in_fundecl.h:35:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz2@ +-} +baz2 = fromBaseForeignType baz2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_459eabcbd019687c" baz3_base :: BaseForeignType (CInt -> + IO (Ptr (ConstantArray 2 + (ConstantArray 3 + I)))) +{-| __C declaration:__ @baz3@ + + __defined at:__ @macros\/macro_in_fundecl.h:43:5@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz3@ +-} +baz3 :: CInt -> IO (Ptr (ConstantArray 2 (ConstantArray 3 I))) {-| __C declaration:__ @baz3@ __defined at:__ @macros\/macro_in_fundecl.h:43:5@ @@ -588,10 +744,10 @@ foreign import ccall safe "hs_bindgen_0b9b2e4d1699b6f3" baz2 :: I -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz3@ -} -foreign import ccall safe "hs_bindgen_459eabcbd019687c" baz3 :: CInt -> - IO (Ptr (ConstantArray 2 - (ConstantArray 3 - I))) +baz3 = fromBaseForeignType baz3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7ae4ab0ad4fb8cad" no_args_no_void_base :: BaseForeignType (IO I) {-| __C declaration:__ @no_args_no_void@ __defined at:__ @macros\/macro_in_fundecl.h:53:3@ @@ -600,7 +756,30 @@ foreign import ccall safe "hs_bindgen_459eabcbd019687c" baz3 :: CInt -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_no_args_no_void@ -} -foreign import ccall safe "hs_bindgen_7ae4ab0ad4fb8cad" no_args_no_void :: IO I +no_args_no_void :: IO I +{-| __C declaration:__ @no_args_no_void@ + + __defined at:__ @macros\/macro_in_fundecl.h:53:3@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_no_args_no_void@ +-} +no_args_no_void = fromBaseForeignType no_args_no_void_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ab9081efcd629826" quux_base :: BaseForeignType (F -> + CChar -> + IO CChar) +{-| __C declaration:__ @quux@ + + __defined at:__ @macros\/macro_in_fundecl.h:12:6@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_quux@ +-} +quux :: F -> CChar -> IO CChar {-| __C declaration:__ @quux@ __defined at:__ @macros\/macro_in_fundecl.h:12:6@ @@ -609,8 +788,12 @@ foreign import ccall safe "hs_bindgen_7ae4ab0ad4fb8cad" no_args_no_void :: IO I __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_quux@ -} -foreign import ccall safe "hs_bindgen_ab9081efcd629826" quux :: F -> - CChar -> IO CChar +quux = fromBaseForeignType quux_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7db4d5f10d9904d8" wam_base :: BaseForeignType (CFloat -> + Ptr C -> + IO (Ptr C)) {-| __C declaration:__ @wam@ __defined at:__ @macros\/macro_in_fundecl.h:13:4@ @@ -619,8 +802,22 @@ foreign import ccall safe "hs_bindgen_ab9081efcd629826" quux :: F -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_wam@ -} -foreign import ccall safe "hs_bindgen_7db4d5f10d9904d8" wam :: CFloat -> - Ptr C -> IO (Ptr C) +wam :: CFloat -> Ptr C -> IO (Ptr C) +{-| __C declaration:__ @wam@ + + __defined at:__ @macros\/macro_in_fundecl.h:13:4@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_wam@ +-} +wam = fromBaseForeignType wam_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_18401e906d384fd5" foo1_base :: BaseForeignType (CFloat -> + FunPtr (CInt -> + IO CInt) -> + IO (Ptr CChar)) {-| __C declaration:__ @foo1@ __defined at:__ @macros\/macro_in_fundecl.h:16:7@ @@ -629,9 +826,22 @@ foreign import ccall safe "hs_bindgen_7db4d5f10d9904d8" wam :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo1@ -} -foreign import ccall safe "hs_bindgen_18401e906d384fd5" foo1 :: CFloat -> - FunPtr (CInt -> IO CInt) -> - IO (Ptr CChar) +foo1 :: CFloat -> FunPtr (CInt -> IO CInt) -> IO (Ptr CChar) +{-| __C declaration:__ @foo1@ + + __defined at:__ @macros\/macro_in_fundecl.h:16:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo1@ +-} +foo1 = fromBaseForeignType foo1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1e16ebe63a290ff6" foo2_base :: BaseForeignType (F -> + FunPtr (CInt -> + IO CInt) -> + IO (Ptr CChar)) {-| __C declaration:__ @foo2@ __defined at:__ @macros\/macro_in_fundecl.h:17:7@ @@ -640,9 +850,22 @@ foreign import ccall safe "hs_bindgen_18401e906d384fd5" foo1 :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo2@ -} -foreign import ccall safe "hs_bindgen_1e16ebe63a290ff6" foo2 :: F -> - FunPtr (CInt -> IO CInt) -> - IO (Ptr CChar) +foo2 :: F -> FunPtr (CInt -> IO CInt) -> IO (Ptr CChar) +{-| __C declaration:__ @foo2@ + + __defined at:__ @macros\/macro_in_fundecl.h:17:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo2@ +-} +foo2 = fromBaseForeignType foo2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_091043692da958ac" foo3_base :: BaseForeignType (CFloat -> + FunPtr (CInt -> + IO CInt) -> + IO (Ptr C)) {-| __C declaration:__ @foo3@ __defined at:__ @macros\/macro_in_fundecl.h:18:4@ @@ -651,9 +874,30 @@ foreign import ccall safe "hs_bindgen_1e16ebe63a290ff6" foo2 :: F -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo3@ -} -foreign import ccall safe "hs_bindgen_091043692da958ac" foo3 :: CFloat -> - FunPtr (CInt -> IO CInt) -> - IO (Ptr C) +foo3 :: CFloat -> FunPtr (CInt -> IO CInt) -> IO (Ptr C) +{-| __C declaration:__ @foo3@ + + __defined at:__ @macros\/macro_in_fundecl.h:18:4@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_foo3@ +-} +foo3 = fromBaseForeignType foo3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cf4fa39c5b4ef431" bar1_base :: BaseForeignType (CLong -> + IO (FunPtr (CShort -> + IO CInt))) +{-| __C declaration:__ @bar1@ + + __defined at:__ @macros\/macro_in_fundecl.h:21:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar1@ +-} +bar1 :: CLong -> IO (FunPtr (CShort -> IO CInt)) {-| __C declaration:__ @bar1@ __defined at:__ @macros\/macro_in_fundecl.h:21:7@ @@ -662,8 +906,21 @@ foreign import ccall safe "hs_bindgen_091043692da958ac" foo3 :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar1@ -} -foreign import ccall safe "hs_bindgen_cf4fa39c5b4ef431" bar1 :: CLong -> - IO (FunPtr (CShort -> IO CInt)) +bar1 = fromBaseForeignType bar1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9092ebfb46f7f31b" bar2_base :: BaseForeignType (L -> + IO (FunPtr (CShort -> + IO CInt))) +{-| __C declaration:__ @bar2@ + + __defined at:__ @macros\/macro_in_fundecl.h:22:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar2@ +-} +bar2 :: L -> IO (FunPtr (CShort -> IO CInt)) {-| __C declaration:__ @bar2@ __defined at:__ @macros\/macro_in_fundecl.h:22:7@ @@ -672,8 +929,21 @@ foreign import ccall safe "hs_bindgen_cf4fa39c5b4ef431" bar1 :: CLong -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar2@ -} -foreign import ccall safe "hs_bindgen_9092ebfb46f7f31b" bar2 :: L -> - IO (FunPtr (CShort -> IO CInt)) +bar2 = fromBaseForeignType bar2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a5e6607b472003eb" bar3_base :: BaseForeignType (CLong -> + IO (FunPtr (S -> + IO CInt))) +{-| __C declaration:__ @bar3@ + + __defined at:__ @macros\/macro_in_fundecl.h:23:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar3@ +-} +bar3 :: CLong -> IO (FunPtr (S -> IO CInt)) {-| __C declaration:__ @bar3@ __defined at:__ @macros\/macro_in_fundecl.h:23:7@ @@ -682,8 +952,12 @@ foreign import ccall safe "hs_bindgen_9092ebfb46f7f31b" bar2 :: L -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar3@ -} -foreign import ccall safe "hs_bindgen_a5e6607b472003eb" bar3 :: CLong -> - IO (FunPtr (S -> IO CInt)) +bar3 = fromBaseForeignType bar3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_050bd8903c7b13dd" bar4_base :: BaseForeignType (CLong -> + IO (FunPtr (CShort -> + IO I))) {-| __C declaration:__ @bar4@ __defined at:__ @macros\/macro_in_fundecl.h:24:5@ @@ -692,8 +966,31 @@ foreign import ccall safe "hs_bindgen_a5e6607b472003eb" bar3 :: CLong -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar4@ -} -foreign import ccall safe "hs_bindgen_050bd8903c7b13dd" bar4 :: CLong -> - IO (FunPtr (CShort -> IO I)) +bar4 :: CLong -> IO (FunPtr (CShort -> IO I)) +{-| __C declaration:__ @bar4@ + + __defined at:__ @macros\/macro_in_fundecl.h:24:5@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_bar4@ +-} +bar4 = fromBaseForeignType bar4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f378b374e8c8c095" baz1_base :: BaseForeignType (CInt -> + IO (Ptr (ConstantArray 2 + (ConstantArray 3 + CInt)))) +{-| __C declaration:__ @baz1@ + + __defined at:__ @macros\/macro_in_fundecl.h:27:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz1@ +-} +baz1 :: CInt -> IO (Ptr (ConstantArray 2 (ConstantArray 3 CInt))) {-| __C declaration:__ @baz1@ __defined at:__ @macros\/macro_in_fundecl.h:27:7@ @@ -702,10 +999,13 @@ foreign import ccall safe "hs_bindgen_050bd8903c7b13dd" bar4 :: CLong -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz1@ -} -foreign import ccall safe "hs_bindgen_f378b374e8c8c095" baz1 :: CInt -> - IO (Ptr (ConstantArray 2 - (ConstantArray 3 - CInt))) +baz1 = fromBaseForeignType baz1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_27cf571d08ac8c04" baz2_base :: BaseForeignType (I -> + IO (Ptr (ConstantArray 2 + (ConstantArray 3 + CInt)))) {-| __C declaration:__ @baz2@ __defined at:__ @macros\/macro_in_fundecl.h:35:7@ @@ -714,10 +1014,31 @@ foreign import ccall safe "hs_bindgen_f378b374e8c8c095" baz1 :: CInt -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz2@ -} -foreign import ccall safe "hs_bindgen_27cf571d08ac8c04" baz2 :: I -> - IO (Ptr (ConstantArray 2 - (ConstantArray 3 - CInt))) +baz2 :: I -> IO (Ptr (ConstantArray 2 (ConstantArray 3 CInt))) +{-| __C declaration:__ @baz2@ + + __defined at:__ @macros\/macro_in_fundecl.h:35:7@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz2@ +-} +baz2 = fromBaseForeignType baz2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c4035ef23b908e27" baz3_base :: BaseForeignType (CInt -> + IO (Ptr (ConstantArray 2 + (ConstantArray 3 + I)))) +{-| __C declaration:__ @baz3@ + + __defined at:__ @macros\/macro_in_fundecl.h:43:5@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz3@ +-} +baz3 :: CInt -> IO (Ptr (ConstantArray 2 (ConstantArray 3 I))) {-| __C declaration:__ @baz3@ __defined at:__ @macros\/macro_in_fundecl.h:43:5@ @@ -726,10 +1047,10 @@ foreign import ccall safe "hs_bindgen_27cf571d08ac8c04" baz2 :: I -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_baz3@ -} -foreign import ccall safe "hs_bindgen_c4035ef23b908e27" baz3 :: CInt -> - IO (Ptr (ConstantArray 2 - (ConstantArray 3 - I))) +baz3 = fromBaseForeignType baz3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_77a9149f03b2767f" no_args_no_void_base :: BaseForeignType (IO I) {-| __C declaration:__ @no_args_no_void@ __defined at:__ @macros\/macro_in_fundecl.h:53:3@ @@ -738,12 +1059,27 @@ foreign import ccall safe "hs_bindgen_c4035ef23b908e27" baz3 :: CInt -> __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_no_args_no_void@ -} -foreign import ccall safe "hs_bindgen_77a9149f03b2767f" no_args_no_void :: IO I +no_args_no_void :: IO I +{-| __C declaration:__ @no_args_no_void@ + + __defined at:__ @macros\/macro_in_fundecl.h:53:3@ + + __exported by:__ @macros\/macro_in_fundecl.h@ + + __unique:__ @test_macrosmacro_in_fundecl_Example_Unsafe_no_args_no_void@ +-} +no_args_no_void = fromBaseForeignType no_args_no_void_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9ba032a8ddf22326" hs_bindgen_9ba032a8ddf22326_base :: BaseForeignType (IO (FunPtr (F -> + CChar -> + IO CChar))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_quux_ptr@ -} -foreign import ccall safe "hs_bindgen_9ba032a8ddf22326" hs_bindgen_9ba032a8ddf22326 :: IO (FunPtr (F -> - CChar -> - IO CChar)) +hs_bindgen_9ba032a8ddf22326 :: IO (FunPtr (F -> CChar -> IO CChar)) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_quux_ptr@ +-} +hs_bindgen_9ba032a8ddf22326 = fromBaseForeignType hs_bindgen_9ba032a8ddf22326_base {-# NOINLINE quux_ptr #-} {-| __C declaration:__ @quux@ @@ -759,11 +1095,18 @@ quux_ptr :: FunPtr (F -> CChar -> IO CChar) __exported by:__ @macros\/macro_in_fundecl.h@ -} quux_ptr = unsafePerformIO hs_bindgen_9ba032a8ddf22326 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dafcba2967781c8d" hs_bindgen_dafcba2967781c8d_base :: BaseForeignType (IO (FunPtr (CFloat -> + Ptr C -> + IO (Ptr C)))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_wam_ptr@ +-} +hs_bindgen_dafcba2967781c8d :: IO (FunPtr (CFloat -> + Ptr C -> IO (Ptr C))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_wam_ptr@ -} -foreign import ccall safe "hs_bindgen_dafcba2967781c8d" hs_bindgen_dafcba2967781c8d :: IO (FunPtr (CFloat -> - Ptr C -> - IO (Ptr C))) +hs_bindgen_dafcba2967781c8d = fromBaseForeignType hs_bindgen_dafcba2967781c8d_base {-# NOINLINE wam_ptr #-} {-| __C declaration:__ @wam@ @@ -779,12 +1122,19 @@ wam_ptr :: FunPtr (CFloat -> Ptr C -> IO (Ptr C)) __exported by:__ @macros\/macro_in_fundecl.h@ -} wam_ptr = unsafePerformIO hs_bindgen_dafcba2967781c8d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_27ded2f560eadb5b" hs_bindgen_27ded2f560eadb5b_base :: BaseForeignType (IO (FunPtr (CFloat -> + FunPtr (CInt -> + IO CInt) -> + IO (Ptr CChar)))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_foo1_ptr@ -} -foreign import ccall safe "hs_bindgen_27ded2f560eadb5b" hs_bindgen_27ded2f560eadb5b :: IO (FunPtr (CFloat -> - FunPtr (CInt -> - IO CInt) -> - IO (Ptr CChar))) +hs_bindgen_27ded2f560eadb5b :: IO (FunPtr (CFloat -> + FunPtr (CInt -> IO CInt) -> IO (Ptr CChar))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_foo1_ptr@ +-} +hs_bindgen_27ded2f560eadb5b = fromBaseForeignType hs_bindgen_27ded2f560eadb5b_base {-# NOINLINE foo1_ptr #-} {-| __C declaration:__ @foo1@ @@ -801,12 +1151,19 @@ foo1_ptr :: FunPtr (CFloat -> __exported by:__ @macros\/macro_in_fundecl.h@ -} foo1_ptr = unsafePerformIO hs_bindgen_27ded2f560eadb5b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2f92fb3aace15650" hs_bindgen_2f92fb3aace15650_base :: BaseForeignType (IO (FunPtr (F -> + FunPtr (CInt -> + IO CInt) -> + IO (Ptr CChar)))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_foo2_ptr@ -} -foreign import ccall safe "hs_bindgen_2f92fb3aace15650" hs_bindgen_2f92fb3aace15650 :: IO (FunPtr (F -> - FunPtr (CInt -> - IO CInt) -> - IO (Ptr CChar))) +hs_bindgen_2f92fb3aace15650 :: IO (FunPtr (F -> + FunPtr (CInt -> IO CInt) -> IO (Ptr CChar))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_foo2_ptr@ +-} +hs_bindgen_2f92fb3aace15650 = fromBaseForeignType hs_bindgen_2f92fb3aace15650_base {-# NOINLINE foo2_ptr #-} {-| __C declaration:__ @foo2@ @@ -823,12 +1180,19 @@ foo2_ptr :: FunPtr (F -> __exported by:__ @macros\/macro_in_fundecl.h@ -} foo2_ptr = unsafePerformIO hs_bindgen_2f92fb3aace15650 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_06568a4cca591e6c" hs_bindgen_06568a4cca591e6c_base :: BaseForeignType (IO (FunPtr (CFloat -> + FunPtr (CInt -> + IO CInt) -> + IO (Ptr C)))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_foo3_ptr@ -} -foreign import ccall safe "hs_bindgen_06568a4cca591e6c" hs_bindgen_06568a4cca591e6c :: IO (FunPtr (CFloat -> - FunPtr (CInt -> - IO CInt) -> - IO (Ptr C))) +hs_bindgen_06568a4cca591e6c :: IO (FunPtr (CFloat -> + FunPtr (CInt -> IO CInt) -> IO (Ptr C))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_foo3_ptr@ +-} +hs_bindgen_06568a4cca591e6c = fromBaseForeignType hs_bindgen_06568a4cca591e6c_base {-# NOINLINE foo3_ptr #-} {-| __C declaration:__ @foo3@ @@ -845,11 +1209,18 @@ foo3_ptr :: FunPtr (CFloat -> __exported by:__ @macros\/macro_in_fundecl.h@ -} foo3_ptr = unsafePerformIO hs_bindgen_06568a4cca591e6c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d9248136916656f7" hs_bindgen_d9248136916656f7_base :: BaseForeignType (IO (FunPtr (CLong -> + IO (FunPtr (CShort -> + IO CInt))))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar1_ptr@ +-} +hs_bindgen_d9248136916656f7 :: IO (FunPtr (CLong -> + IO (FunPtr (CShort -> IO CInt)))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar1_ptr@ -} -foreign import ccall safe "hs_bindgen_d9248136916656f7" hs_bindgen_d9248136916656f7 :: IO (FunPtr (CLong -> - IO (FunPtr (CShort -> - IO CInt)))) +hs_bindgen_d9248136916656f7 = fromBaseForeignType hs_bindgen_d9248136916656f7_base {-# NOINLINE bar1_ptr #-} {-| __C declaration:__ @bar1@ @@ -865,11 +1236,18 @@ bar1_ptr :: FunPtr (CLong -> IO (FunPtr (CShort -> IO CInt))) __exported by:__ @macros\/macro_in_fundecl.h@ -} bar1_ptr = unsafePerformIO hs_bindgen_d9248136916656f7 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2638a77b200d9571" hs_bindgen_2638a77b200d9571_base :: BaseForeignType (IO (FunPtr (L -> + IO (FunPtr (CShort -> + IO CInt))))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar2_ptr@ +-} +hs_bindgen_2638a77b200d9571 :: IO (FunPtr (L -> + IO (FunPtr (CShort -> IO CInt)))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar2_ptr@ -} -foreign import ccall safe "hs_bindgen_2638a77b200d9571" hs_bindgen_2638a77b200d9571 :: IO (FunPtr (L -> - IO (FunPtr (CShort -> - IO CInt)))) +hs_bindgen_2638a77b200d9571 = fromBaseForeignType hs_bindgen_2638a77b200d9571_base {-# NOINLINE bar2_ptr #-} {-| __C declaration:__ @bar2@ @@ -885,11 +1263,18 @@ bar2_ptr :: FunPtr (L -> IO (FunPtr (CShort -> IO CInt))) __exported by:__ @macros\/macro_in_fundecl.h@ -} bar2_ptr = unsafePerformIO hs_bindgen_2638a77b200d9571 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ebbd5d09631f1f45" hs_bindgen_ebbd5d09631f1f45_base :: BaseForeignType (IO (FunPtr (CLong -> + IO (FunPtr (S -> + IO CInt))))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar3_ptr@ -} -foreign import ccall safe "hs_bindgen_ebbd5d09631f1f45" hs_bindgen_ebbd5d09631f1f45 :: IO (FunPtr (CLong -> - IO (FunPtr (S -> - IO CInt)))) +hs_bindgen_ebbd5d09631f1f45 :: IO (FunPtr (CLong -> + IO (FunPtr (S -> IO CInt)))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar3_ptr@ +-} +hs_bindgen_ebbd5d09631f1f45 = fromBaseForeignType hs_bindgen_ebbd5d09631f1f45_base {-# NOINLINE bar3_ptr #-} {-| __C declaration:__ @bar3@ @@ -905,11 +1290,18 @@ bar3_ptr :: FunPtr (CLong -> IO (FunPtr (S -> IO CInt))) __exported by:__ @macros\/macro_in_fundecl.h@ -} bar3_ptr = unsafePerformIO hs_bindgen_ebbd5d09631f1f45 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7082943a6d3dd96f" hs_bindgen_7082943a6d3dd96f_base :: BaseForeignType (IO (FunPtr (CLong -> + IO (FunPtr (CShort -> + IO I))))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar4_ptr@ +-} +hs_bindgen_7082943a6d3dd96f :: IO (FunPtr (CLong -> + IO (FunPtr (CShort -> IO I)))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_bar4_ptr@ -} -foreign import ccall safe "hs_bindgen_7082943a6d3dd96f" hs_bindgen_7082943a6d3dd96f :: IO (FunPtr (CLong -> - IO (FunPtr (CShort -> - IO I)))) +hs_bindgen_7082943a6d3dd96f = fromBaseForeignType hs_bindgen_7082943a6d3dd96f_base {-# NOINLINE bar4_ptr #-} {-| __C declaration:__ @bar4@ @@ -925,12 +1317,19 @@ bar4_ptr :: FunPtr (CLong -> IO (FunPtr (CShort -> IO I))) __exported by:__ @macros\/macro_in_fundecl.h@ -} bar4_ptr = unsafePerformIO hs_bindgen_7082943a6d3dd96f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d13a2e48d313bb66" hs_bindgen_d13a2e48d313bb66_base :: BaseForeignType (IO (FunPtr (CInt -> + IO (Ptr (ConstantArray 2 + (ConstantArray 3 + CInt)))))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_baz1_ptr@ +-} +hs_bindgen_d13a2e48d313bb66 :: IO (FunPtr (CInt -> + IO (Ptr (ConstantArray 2 (ConstantArray 3 CInt))))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_baz1_ptr@ -} -foreign import ccall safe "hs_bindgen_d13a2e48d313bb66" hs_bindgen_d13a2e48d313bb66 :: IO (FunPtr (CInt -> - IO (Ptr (ConstantArray 2 - (ConstantArray 3 - CInt))))) +hs_bindgen_d13a2e48d313bb66 = fromBaseForeignType hs_bindgen_d13a2e48d313bb66_base {-# NOINLINE baz1_ptr #-} {-| __C declaration:__ @baz1@ @@ -947,12 +1346,19 @@ baz1_ptr :: FunPtr (CInt -> __exported by:__ @macros\/macro_in_fundecl.h@ -} baz1_ptr = unsafePerformIO hs_bindgen_d13a2e48d313bb66 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2e558de67f4f715d" hs_bindgen_2e558de67f4f715d_base :: BaseForeignType (IO (FunPtr (I -> + IO (Ptr (ConstantArray 2 + (ConstantArray 3 + CInt)))))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_baz2_ptr@ -} -foreign import ccall safe "hs_bindgen_2e558de67f4f715d" hs_bindgen_2e558de67f4f715d :: IO (FunPtr (I -> - IO (Ptr (ConstantArray 2 - (ConstantArray 3 - CInt))))) +hs_bindgen_2e558de67f4f715d :: IO (FunPtr (I -> + IO (Ptr (ConstantArray 2 (ConstantArray 3 CInt))))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_baz2_ptr@ +-} +hs_bindgen_2e558de67f4f715d = fromBaseForeignType hs_bindgen_2e558de67f4f715d_base {-# NOINLINE baz2_ptr #-} {-| __C declaration:__ @baz2@ @@ -969,12 +1375,19 @@ baz2_ptr :: FunPtr (I -> __exported by:__ @macros\/macro_in_fundecl.h@ -} baz2_ptr = unsafePerformIO hs_bindgen_2e558de67f4f715d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7aba9db18419135a" hs_bindgen_7aba9db18419135a_base :: BaseForeignType (IO (FunPtr (CInt -> + IO (Ptr (ConstantArray 2 + (ConstantArray 3 + I)))))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_baz3_ptr@ +-} +hs_bindgen_7aba9db18419135a :: IO (FunPtr (CInt -> + IO (Ptr (ConstantArray 2 (ConstantArray 3 I))))) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_baz3_ptr@ -} -foreign import ccall safe "hs_bindgen_7aba9db18419135a" hs_bindgen_7aba9db18419135a :: IO (FunPtr (CInt -> - IO (Ptr (ConstantArray 2 - (ConstantArray 3 - I))))) +hs_bindgen_7aba9db18419135a = fromBaseForeignType hs_bindgen_7aba9db18419135a_base {-# NOINLINE baz3_ptr #-} {-| __C declaration:__ @baz3@ @@ -991,9 +1404,15 @@ baz3_ptr :: FunPtr (CInt -> __exported by:__ @macros\/macro_in_fundecl.h@ -} baz3_ptr = unsafePerformIO hs_bindgen_7aba9db18419135a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_35d1920cc9d86b63" hs_bindgen_35d1920cc9d86b63_base :: BaseForeignType (IO (FunPtr (IO I))) +{-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_no_args_no_void_ptr@ +-} +hs_bindgen_35d1920cc9d86b63 :: IO (FunPtr (IO I)) {-| __unique:__ @test_macrosmacro_in_fundecl_Example_get_no_args_no_void_ptr@ -} -foreign import ccall safe "hs_bindgen_35d1920cc9d86b63" hs_bindgen_35d1920cc9d86b63 :: IO (FunPtr (IO I)) +hs_bindgen_35d1920cc9d86b63 = fromBaseForeignType hs_bindgen_35d1920cc9d86b63_base {-# NOINLINE no_args_no_void_ptr #-} {-| __C declaration:__ @no_args_no_void@ diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/FunPtr.hs b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/FunPtr.hs index ade53e8c2..6b761f23e 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -106,10 +107,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fb1d9bc73e620f06" hs_bindgen_fb1d9bc73e620f06_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (MC -> TC -> IO FC.CChar))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_quux1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_fb1d9bc73e620f06" hs_bindgen_fb1d9bc73e620f06 :: +hs_bindgen_fb1d9bc73e620f06 :: IO (Ptr.FunPtr (MC -> TC -> IO FC.CChar)) +hs_bindgen_fb1d9bc73e620f06 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_fb1d9bc73e620f06_base {-# NOINLINE quux1_ptr #-} @@ -123,10 +131,17 @@ quux1_ptr :: Ptr.FunPtr (MC -> TC -> IO FC.CChar) quux1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_fb1d9bc73e620f06 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9dc824587cab07a2" hs_bindgen_9dc824587cab07a2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (MC -> FC.CChar -> IO TC))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_quux2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9dc824587cab07a2" hs_bindgen_9dc824587cab07a2 :: +hs_bindgen_9dc824587cab07a2 :: IO (Ptr.FunPtr (MC -> FC.CChar -> IO TC)) +hs_bindgen_9dc824587cab07a2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9dc824587cab07a2_base {-# NOINLINE quux2_ptr #-} @@ -140,10 +155,17 @@ quux2_ptr :: Ptr.FunPtr (MC -> FC.CChar -> IO TC) quux2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9dc824587cab07a2 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_03d794639e412075" hs_bindgen_03d794639e412075_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CFloat -> (Ptr.Ptr TC) -> IO (Ptr.Ptr MC)))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_wam1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_03d794639e412075" hs_bindgen_03d794639e412075 :: +hs_bindgen_03d794639e412075 :: IO (Ptr.FunPtr (FC.CFloat -> (Ptr.Ptr TC) -> IO (Ptr.Ptr MC))) +hs_bindgen_03d794639e412075 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_03d794639e412075_base {-# NOINLINE wam1_ptr #-} @@ -157,10 +179,17 @@ wam1_ptr :: Ptr.FunPtr (FC.CFloat -> (Ptr.Ptr TC) -> IO (Ptr.Ptr MC)) wam1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_03d794639e412075 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0a5eb04fc739212a" hs_bindgen_0a5eb04fc739212a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CFloat -> (Ptr.Ptr MC) -> IO (Ptr.Ptr TC)))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_wam2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_0a5eb04fc739212a" hs_bindgen_0a5eb04fc739212a :: +hs_bindgen_0a5eb04fc739212a :: IO (Ptr.FunPtr (FC.CFloat -> (Ptr.Ptr MC) -> IO (Ptr.Ptr TC))) +hs_bindgen_0a5eb04fc739212a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_0a5eb04fc739212a_base {-# NOINLINE wam2_ptr #-} @@ -174,10 +203,17 @@ wam2_ptr :: Ptr.FunPtr (FC.CFloat -> (Ptr.Ptr MC) -> IO (Ptr.Ptr TC)) wam2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_0a5eb04fc739212a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6d4f35a86a00c68b" hs_bindgen_6d4f35a86a00c68b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Struct2) -> MC -> IO ()))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_typedef1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_6d4f35a86a00c68b" hs_bindgen_6d4f35a86a00c68b :: +hs_bindgen_6d4f35a86a00c68b :: IO (Ptr.FunPtr ((Ptr.Ptr Struct2) -> MC -> IO ())) +hs_bindgen_6d4f35a86a00c68b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_6d4f35a86a00c68b_base {-# NOINLINE struct_typedef1_ptr #-} @@ -191,10 +227,17 @@ struct_typedef1_ptr :: Ptr.FunPtr ((Ptr.Ptr Struct2) -> MC -> IO ()) struct_typedef1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_6d4f35a86a00c68b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_af92d1197a77fe13" hs_bindgen_af92d1197a77fe13_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Struct3_t) -> MC -> IO ()))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_typedef2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_af92d1197a77fe13" hs_bindgen_af92d1197a77fe13 :: +hs_bindgen_af92d1197a77fe13 :: IO (Ptr.FunPtr ((Ptr.Ptr Struct3_t) -> MC -> IO ())) +hs_bindgen_af92d1197a77fe13 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_af92d1197a77fe13_base {-# NOINLINE struct_typedef2_ptr #-} @@ -208,10 +251,17 @@ struct_typedef2_ptr :: Ptr.FunPtr ((Ptr.Ptr Struct3_t) -> MC -> IO ()) struct_typedef2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_af92d1197a77fe13 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c5effcd02d3d5efd" hs_bindgen_c5effcd02d3d5efd_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Struct4) -> MC -> IO ()))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_typedef3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c5effcd02d3d5efd" hs_bindgen_c5effcd02d3d5efd :: +hs_bindgen_c5effcd02d3d5efd :: IO (Ptr.FunPtr ((Ptr.Ptr Struct4) -> MC -> IO ())) +hs_bindgen_c5effcd02d3d5efd = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c5effcd02d3d5efd_base {-# NOINLINE struct_typedef3_ptr #-} @@ -225,10 +275,17 @@ struct_typedef3_ptr :: Ptr.FunPtr ((Ptr.Ptr Struct4) -> MC -> IO ()) struct_typedef3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c5effcd02d3d5efd +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_842a0d61a7a895d6" hs_bindgen_842a0d61a7a895d6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Struct1) -> MC -> IO ()))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_name1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_842a0d61a7a895d6" hs_bindgen_842a0d61a7a895d6 :: +hs_bindgen_842a0d61a7a895d6 :: IO (Ptr.FunPtr ((Ptr.Ptr Struct1) -> MC -> IO ())) +hs_bindgen_842a0d61a7a895d6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_842a0d61a7a895d6_base {-# NOINLINE struct_name1_ptr #-} @@ -242,10 +299,17 @@ struct_name1_ptr :: Ptr.FunPtr ((Ptr.Ptr Struct1) -> MC -> IO ()) struct_name1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_842a0d61a7a895d6 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ead25a696827a8f7" hs_bindgen_ead25a696827a8f7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Struct3) -> MC -> IO ()))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_name2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ead25a696827a8f7" hs_bindgen_ead25a696827a8f7 :: +hs_bindgen_ead25a696827a8f7 :: IO (Ptr.FunPtr ((Ptr.Ptr Struct3) -> MC -> IO ())) +hs_bindgen_ead25a696827a8f7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ead25a696827a8f7_base {-# NOINLINE struct_name2_ptr #-} @@ -259,10 +323,17 @@ struct_name2_ptr :: Ptr.FunPtr ((Ptr.Ptr Struct3) -> MC -> IO ()) struct_name2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_ead25a696827a8f7 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_680e8a5d673ce9c1" hs_bindgen_680e8a5d673ce9c1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Struct4) -> MC -> IO ()))) + {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_name3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_680e8a5d673ce9c1" hs_bindgen_680e8a5d673ce9c1 :: +hs_bindgen_680e8a5d673ce9c1 :: IO (Ptr.FunPtr ((Ptr.Ptr Struct4) -> MC -> IO ())) +hs_bindgen_680e8a5d673ce9c1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_680e8a5d673ce9c1_base {-# NOINLINE struct_name3_ptr #-} diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/Safe.hs b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/Safe.hs index 0f2a1edca..9945a00de 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/Safe.hs +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/Safe.hs @@ -7,6 +7,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -85,6 +86,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_02e0e3b28d470fd4" quux1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (MC -> TC -> IO FC.CChar) + {-| __C declaration:__ @quux1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:8:6@ @@ -93,7 +99,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_quux1@ -} -foreign import ccall safe "hs_bindgen_02e0e3b28d470fd4" quux1 :: +quux1 :: MC {- ^ __C declaration:__ @x@ -} @@ -101,6 +107,13 @@ foreign import ccall safe "hs_bindgen_02e0e3b28d470fd4" quux1 :: {- ^ __C declaration:__ @y@ -} -> IO FC.CChar +quux1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType quux1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bb79188c8775e2e4" quux2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (MC -> FC.CChar -> IO TC) {-| __C declaration:__ @quux2@ @@ -110,7 +123,7 @@ foreign import ccall safe "hs_bindgen_02e0e3b28d470fd4" quux1 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_quux2@ -} -foreign import ccall safe "hs_bindgen_bb79188c8775e2e4" quux2 :: +quux2 :: MC {- ^ __C declaration:__ @x@ -} @@ -118,6 +131,13 @@ foreign import ccall safe "hs_bindgen_bb79188c8775e2e4" quux2 :: {- ^ __C declaration:__ @y@ -} -> IO TC +quux2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType quux2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a398fb73645271c5" wam1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.Ptr TC) -> IO (Ptr.Ptr MC)) {-| __C declaration:__ @wam1@ @@ -127,7 +147,7 @@ foreign import ccall safe "hs_bindgen_bb79188c8775e2e4" quux2 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_wam1@ -} -foreign import ccall safe "hs_bindgen_a398fb73645271c5" wam1 :: +wam1 :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -135,6 +155,13 @@ foreign import ccall safe "hs_bindgen_a398fb73645271c5" wam1 :: {- ^ __C declaration:__ @y@ -} -> IO (Ptr.Ptr MC) +wam1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType wam1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ad904da072e0711e" wam2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.Ptr MC) -> IO (Ptr.Ptr TC)) {-| __C declaration:__ @wam2@ @@ -144,7 +171,7 @@ foreign import ccall safe "hs_bindgen_a398fb73645271c5" wam1 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_wam2@ -} -foreign import ccall safe "hs_bindgen_ad904da072e0711e" wam2 :: +wam2 :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -152,6 +179,13 @@ foreign import ccall safe "hs_bindgen_ad904da072e0711e" wam2 :: {- ^ __C declaration:__ @y@ -} -> IO (Ptr.Ptr TC) +wam2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType wam2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_88e976dc10571000" struct_typedef1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct2) -> MC -> IO ()) {-| __C declaration:__ @struct_typedef1@ @@ -161,7 +195,7 @@ foreign import ccall safe "hs_bindgen_ad904da072e0711e" wam2 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_struct_typedef1@ -} -foreign import ccall safe "hs_bindgen_88e976dc10571000" struct_typedef1 :: +struct_typedef1 :: Ptr.Ptr Struct2 {- ^ __C declaration:__ @s@ -} @@ -169,6 +203,13 @@ foreign import ccall safe "hs_bindgen_88e976dc10571000" struct_typedef1 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_typedef1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_typedef1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_edb3806d45d7605b" struct_typedef2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct3_t) -> MC -> IO ()) {-| __C declaration:__ @struct_typedef2@ @@ -178,7 +219,7 @@ foreign import ccall safe "hs_bindgen_88e976dc10571000" struct_typedef1 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_struct_typedef2@ -} -foreign import ccall safe "hs_bindgen_edb3806d45d7605b" struct_typedef2 :: +struct_typedef2 :: Ptr.Ptr Struct3_t {- ^ __C declaration:__ @s@ -} @@ -186,6 +227,13 @@ foreign import ccall safe "hs_bindgen_edb3806d45d7605b" struct_typedef2 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_typedef2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_typedef2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7c7f3ab0dd790fe8" struct_typedef3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct4) -> MC -> IO ()) {-| __C declaration:__ @struct_typedef3@ @@ -195,7 +243,7 @@ foreign import ccall safe "hs_bindgen_edb3806d45d7605b" struct_typedef2 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_struct_typedef3@ -} -foreign import ccall safe "hs_bindgen_7c7f3ab0dd790fe8" struct_typedef3 :: +struct_typedef3 :: Ptr.Ptr Struct4 {- ^ __C declaration:__ @s@ -} @@ -203,6 +251,13 @@ foreign import ccall safe "hs_bindgen_7c7f3ab0dd790fe8" struct_typedef3 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_typedef3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_typedef3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2cfbb4f5834d4bcb" struct_name1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct1) -> MC -> IO ()) {-| __C declaration:__ @struct_name1@ @@ -212,7 +267,7 @@ foreign import ccall safe "hs_bindgen_7c7f3ab0dd790fe8" struct_typedef3 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_struct_name1@ -} -foreign import ccall safe "hs_bindgen_2cfbb4f5834d4bcb" struct_name1 :: +struct_name1 :: Ptr.Ptr Struct1 {- ^ __C declaration:__ @s@ -} @@ -220,6 +275,13 @@ foreign import ccall safe "hs_bindgen_2cfbb4f5834d4bcb" struct_name1 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_name1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_name1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c8b765fa70f95167" struct_name2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct3) -> MC -> IO ()) {-| __C declaration:__ @struct_name2@ @@ -229,7 +291,7 @@ foreign import ccall safe "hs_bindgen_2cfbb4f5834d4bcb" struct_name1 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_struct_name2@ -} -foreign import ccall safe "hs_bindgen_c8b765fa70f95167" struct_name2 :: +struct_name2 :: Ptr.Ptr Struct3 {- ^ __C declaration:__ @s@ -} @@ -237,6 +299,13 @@ foreign import ccall safe "hs_bindgen_c8b765fa70f95167" struct_name2 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_name2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_name2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0ff3632971f092bb" struct_name3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct4) -> MC -> IO ()) {-| __C declaration:__ @struct_name3@ @@ -246,7 +315,7 @@ foreign import ccall safe "hs_bindgen_c8b765fa70f95167" struct_name2 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Safe_struct_name3@ -} -foreign import ccall safe "hs_bindgen_0ff3632971f092bb" struct_name3 :: +struct_name3 :: Ptr.Ptr Struct4 {- ^ __C declaration:__ @s@ -} @@ -254,3 +323,5 @@ foreign import ccall safe "hs_bindgen_0ff3632971f092bb" struct_name3 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_name3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_name3_base diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/Unsafe.hs b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/Unsafe.hs index 2741a91f5..fe41ec5b4 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/Example/Unsafe.hs @@ -7,6 +7,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -85,6 +86,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_df7e2b8e86de411a" quux1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (MC -> TC -> IO FC.CChar) + {-| __C declaration:__ @quux1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:8:6@ @@ -93,7 +99,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux1@ -} -foreign import ccall unsafe "hs_bindgen_df7e2b8e86de411a" quux1 :: +quux1 :: MC {- ^ __C declaration:__ @x@ -} @@ -101,6 +107,13 @@ foreign import ccall unsafe "hs_bindgen_df7e2b8e86de411a" quux1 :: {- ^ __C declaration:__ @y@ -} -> IO FC.CChar +quux1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType quux1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6f0b13ed02b696df" quux2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (MC -> FC.CChar -> IO TC) {-| __C declaration:__ @quux2@ @@ -110,7 +123,7 @@ foreign import ccall unsafe "hs_bindgen_df7e2b8e86de411a" quux1 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux2@ -} -foreign import ccall unsafe "hs_bindgen_6f0b13ed02b696df" quux2 :: +quux2 :: MC {- ^ __C declaration:__ @x@ -} @@ -118,6 +131,13 @@ foreign import ccall unsafe "hs_bindgen_6f0b13ed02b696df" quux2 :: {- ^ __C declaration:__ @y@ -} -> IO TC +quux2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType quux2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f92059cc98dde342" wam1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.Ptr TC) -> IO (Ptr.Ptr MC)) {-| __C declaration:__ @wam1@ @@ -127,7 +147,7 @@ foreign import ccall unsafe "hs_bindgen_6f0b13ed02b696df" quux2 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam1@ -} -foreign import ccall unsafe "hs_bindgen_f92059cc98dde342" wam1 :: +wam1 :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -135,6 +155,13 @@ foreign import ccall unsafe "hs_bindgen_f92059cc98dde342" wam1 :: {- ^ __C declaration:__ @y@ -} -> IO (Ptr.Ptr MC) +wam1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType wam1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3e6ecd1b2cc616bc" wam2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CFloat -> (Ptr.Ptr MC) -> IO (Ptr.Ptr TC)) {-| __C declaration:__ @wam2@ @@ -144,7 +171,7 @@ foreign import ccall unsafe "hs_bindgen_f92059cc98dde342" wam1 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam2@ -} -foreign import ccall unsafe "hs_bindgen_3e6ecd1b2cc616bc" wam2 :: +wam2 :: FC.CFloat {- ^ __C declaration:__ @x@ -} @@ -152,6 +179,13 @@ foreign import ccall unsafe "hs_bindgen_3e6ecd1b2cc616bc" wam2 :: {- ^ __C declaration:__ @y@ -} -> IO (Ptr.Ptr TC) +wam2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType wam2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ffa9d5a3e8f0f221" struct_typedef1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct2) -> MC -> IO ()) {-| __C declaration:__ @struct_typedef1@ @@ -161,7 +195,7 @@ foreign import ccall unsafe "hs_bindgen_3e6ecd1b2cc616bc" wam2 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef1@ -} -foreign import ccall unsafe "hs_bindgen_ffa9d5a3e8f0f221" struct_typedef1 :: +struct_typedef1 :: Ptr.Ptr Struct2 {- ^ __C declaration:__ @s@ -} @@ -169,6 +203,13 @@ foreign import ccall unsafe "hs_bindgen_ffa9d5a3e8f0f221" struct_typedef1 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_typedef1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_typedef1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4801667560542114" struct_typedef2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct3_t) -> MC -> IO ()) {-| __C declaration:__ @struct_typedef2@ @@ -178,7 +219,7 @@ foreign import ccall unsafe "hs_bindgen_ffa9d5a3e8f0f221" struct_typedef1 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef2@ -} -foreign import ccall unsafe "hs_bindgen_4801667560542114" struct_typedef2 :: +struct_typedef2 :: Ptr.Ptr Struct3_t {- ^ __C declaration:__ @s@ -} @@ -186,6 +227,13 @@ foreign import ccall unsafe "hs_bindgen_4801667560542114" struct_typedef2 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_typedef2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_typedef2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_04fa5bbd479146eb" struct_typedef3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct4) -> MC -> IO ()) {-| __C declaration:__ @struct_typedef3@ @@ -195,7 +243,7 @@ foreign import ccall unsafe "hs_bindgen_4801667560542114" struct_typedef2 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef3@ -} -foreign import ccall unsafe "hs_bindgen_04fa5bbd479146eb" struct_typedef3 :: +struct_typedef3 :: Ptr.Ptr Struct4 {- ^ __C declaration:__ @s@ -} @@ -203,6 +251,13 @@ foreign import ccall unsafe "hs_bindgen_04fa5bbd479146eb" struct_typedef3 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_typedef3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_typedef3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_08025fd0bd589ac2" struct_name1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct1) -> MC -> IO ()) {-| __C declaration:__ @struct_name1@ @@ -212,7 +267,7 @@ foreign import ccall unsafe "hs_bindgen_04fa5bbd479146eb" struct_typedef3 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name1@ -} -foreign import ccall unsafe "hs_bindgen_08025fd0bd589ac2" struct_name1 :: +struct_name1 :: Ptr.Ptr Struct1 {- ^ __C declaration:__ @s@ -} @@ -220,6 +275,13 @@ foreign import ccall unsafe "hs_bindgen_08025fd0bd589ac2" struct_name1 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_name1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_name1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9de286608f952fc7" struct_name2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct3) -> MC -> IO ()) {-| __C declaration:__ @struct_name2@ @@ -229,7 +291,7 @@ foreign import ccall unsafe "hs_bindgen_08025fd0bd589ac2" struct_name1 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name2@ -} -foreign import ccall unsafe "hs_bindgen_9de286608f952fc7" struct_name2 :: +struct_name2 :: Ptr.Ptr Struct3 {- ^ __C declaration:__ @s@ -} @@ -237,6 +299,13 @@ foreign import ccall unsafe "hs_bindgen_9de286608f952fc7" struct_name2 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_name2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_name2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_38cce6bb1ac71578" struct_name3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Struct4) -> MC -> IO ()) {-| __C declaration:__ @struct_name3@ @@ -246,7 +315,7 @@ foreign import ccall unsafe "hs_bindgen_9de286608f952fc7" struct_name2 :: __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name3@ -} -foreign import ccall unsafe "hs_bindgen_38cce6bb1ac71578" struct_name3 :: +struct_name3 :: Ptr.Ptr Struct4 {- ^ __C declaration:__ @s@ -} @@ -254,3 +323,5 @@ foreign import ccall unsafe "hs_bindgen_38cce6bb1ac71578" struct_name3 :: {- ^ __C declaration:__ @x@ -} -> IO () +struct_name3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType struct_name3_base diff --git a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/th.txt b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/th.txt index 8357a06cd..3287ab175 100644 --- a/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/th.txt +++ b/hs-bindgen/fixtures/macros/macro_in_fundecl_vs_typedef/th.txt @@ -436,6 +436,20 @@ instance HasCField Struct4 "struct4_a" instance TyEq ty (CFieldType Struct4 "struct4_a") => HasField "struct4_a" (Ptr Struct4) (Ptr ty) where getField = ptrToCField (Proxy @"struct4_a") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_02e0e3b28d470fd4" quux1_base :: BaseForeignType (MC -> + TC -> + IO CChar) +{-| __C declaration:__ @quux1@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:8:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux1@ +-} +quux1 :: MC -> TC -> IO CChar {-| __C declaration:__ @quux1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:8:6@ @@ -444,8 +458,12 @@ instance TyEq ty (CFieldType Struct4 "struct4_a") => __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux1@ -} -foreign import ccall safe "hs_bindgen_02e0e3b28d470fd4" quux1 :: MC -> - TC -> IO CChar +quux1 = fromBaseForeignType quux1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bb79188c8775e2e4" quux2_base :: BaseForeignType (MC -> + CChar -> + IO TC) {-| __C declaration:__ @quux2@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:9:4@ @@ -454,8 +472,30 @@ foreign import ccall safe "hs_bindgen_02e0e3b28d470fd4" quux1 :: MC -> __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux2@ -} -foreign import ccall safe "hs_bindgen_bb79188c8775e2e4" quux2 :: MC -> - CChar -> IO TC +quux2 :: MC -> CChar -> IO TC +{-| __C declaration:__ @quux2@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:9:4@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux2@ +-} +quux2 = fromBaseForeignType quux2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a398fb73645271c5" wam1_base :: BaseForeignType (CFloat -> + Ptr TC -> + IO (Ptr MC)) +{-| __C declaration:__ @wam1@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:10:5@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam1@ +-} +wam1 :: CFloat -> Ptr TC -> IO (Ptr MC) {-| __C declaration:__ @wam1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:10:5@ @@ -464,8 +504,12 @@ foreign import ccall safe "hs_bindgen_bb79188c8775e2e4" quux2 :: MC -> __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam1@ -} -foreign import ccall safe "hs_bindgen_a398fb73645271c5" wam1 :: CFloat -> - Ptr TC -> IO (Ptr MC) +wam1 = fromBaseForeignType wam1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ad904da072e0711e" wam2_base :: BaseForeignType (CFloat -> + Ptr MC -> + IO (Ptr TC)) {-| __C declaration:__ @wam2@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:11:5@ @@ -474,8 +518,30 @@ foreign import ccall safe "hs_bindgen_a398fb73645271c5" wam1 :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam2@ -} -foreign import ccall safe "hs_bindgen_ad904da072e0711e" wam2 :: CFloat -> - Ptr MC -> IO (Ptr TC) +wam2 :: CFloat -> Ptr MC -> IO (Ptr TC) +{-| __C declaration:__ @wam2@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:11:5@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam2@ +-} +wam2 = fromBaseForeignType wam2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_88e976dc10571000" struct_typedef1_base :: BaseForeignType (Ptr Struct2 -> + MC -> + IO Unit) +{-| __C declaration:__ @struct_typedef1@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:23:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef1@ +-} +struct_typedef1 :: Ptr Struct2 -> MC -> IO Unit {-| __C declaration:__ @struct_typedef1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:23:6@ @@ -484,8 +550,12 @@ foreign import ccall safe "hs_bindgen_ad904da072e0711e" wam2 :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef1@ -} -foreign import ccall safe "hs_bindgen_88e976dc10571000" struct_typedef1 :: Ptr Struct2 -> - MC -> IO Unit +struct_typedef1 = fromBaseForeignType struct_typedef1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_edb3806d45d7605b" struct_typedef2_base :: BaseForeignType (Ptr Struct3_t -> + MC -> + IO Unit) {-| __C declaration:__ @struct_typedef2@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:24:6@ @@ -494,8 +564,21 @@ foreign import ccall safe "hs_bindgen_88e976dc10571000" struct_typedef1 :: Ptr S __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef2@ -} -foreign import ccall safe "hs_bindgen_edb3806d45d7605b" struct_typedef2 :: Ptr Struct3_t -> - MC -> IO Unit +struct_typedef2 :: Ptr Struct3_t -> MC -> IO Unit +{-| __C declaration:__ @struct_typedef2@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:24:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef2@ +-} +struct_typedef2 = fromBaseForeignType struct_typedef2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7c7f3ab0dd790fe8" struct_typedef3_base :: BaseForeignType (Ptr Struct4 -> + MC -> + IO Unit) {-| __C declaration:__ @struct_typedef3@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:25:6@ @@ -504,8 +587,30 @@ foreign import ccall safe "hs_bindgen_edb3806d45d7605b" struct_typedef2 :: Ptr S __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef3@ -} -foreign import ccall safe "hs_bindgen_7c7f3ab0dd790fe8" struct_typedef3 :: Ptr Struct4 -> - MC -> IO Unit +struct_typedef3 :: Ptr Struct4 -> MC -> IO Unit +{-| __C declaration:__ @struct_typedef3@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:25:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef3@ +-} +struct_typedef3 = fromBaseForeignType struct_typedef3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2cfbb4f5834d4bcb" struct_name1_base :: BaseForeignType (Ptr Struct1 -> + MC -> + IO Unit) +{-| __C declaration:__ @struct_name1@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:27:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name1@ +-} +struct_name1 :: Ptr Struct1 -> MC -> IO Unit {-| __C declaration:__ @struct_name1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:27:6@ @@ -514,8 +619,21 @@ foreign import ccall safe "hs_bindgen_7c7f3ab0dd790fe8" struct_typedef3 :: Ptr S __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name1@ -} -foreign import ccall safe "hs_bindgen_2cfbb4f5834d4bcb" struct_name1 :: Ptr Struct1 -> - MC -> IO Unit +struct_name1 = fromBaseForeignType struct_name1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c8b765fa70f95167" struct_name2_base :: BaseForeignType (Ptr Struct3 -> + MC -> + IO Unit) +{-| __C declaration:__ @struct_name2@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:28:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name2@ +-} +struct_name2 :: Ptr Struct3 -> MC -> IO Unit {-| __C declaration:__ @struct_name2@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:28:6@ @@ -524,8 +642,12 @@ foreign import ccall safe "hs_bindgen_2cfbb4f5834d4bcb" struct_name1 :: Ptr Stru __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name2@ -} -foreign import ccall safe "hs_bindgen_c8b765fa70f95167" struct_name2 :: Ptr Struct3 -> - MC -> IO Unit +struct_name2 = fromBaseForeignType struct_name2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0ff3632971f092bb" struct_name3_base :: BaseForeignType (Ptr Struct4 -> + MC -> + IO Unit) {-| __C declaration:__ @struct_name3@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:29:6@ @@ -534,8 +656,30 @@ foreign import ccall safe "hs_bindgen_c8b765fa70f95167" struct_name2 :: Ptr Stru __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name3@ -} -foreign import ccall safe "hs_bindgen_0ff3632971f092bb" struct_name3 :: Ptr Struct4 -> - MC -> IO Unit +struct_name3 :: Ptr Struct4 -> MC -> IO Unit +{-| __C declaration:__ @struct_name3@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:29:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name3@ +-} +struct_name3 = fromBaseForeignType struct_name3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_df7e2b8e86de411a" quux1_base :: BaseForeignType (MC -> + TC -> + IO CChar) +{-| __C declaration:__ @quux1@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:8:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux1@ +-} +quux1 :: MC -> TC -> IO CChar {-| __C declaration:__ @quux1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:8:6@ @@ -544,8 +688,21 @@ foreign import ccall safe "hs_bindgen_0ff3632971f092bb" struct_name3 :: Ptr Stru __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux1@ -} -foreign import ccall safe "hs_bindgen_df7e2b8e86de411a" quux1 :: MC -> - TC -> IO CChar +quux1 = fromBaseForeignType quux1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6f0b13ed02b696df" quux2_base :: BaseForeignType (MC -> + CChar -> + IO TC) +{-| __C declaration:__ @quux2@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:9:4@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux2@ +-} +quux2 :: MC -> CChar -> IO TC {-| __C declaration:__ @quux2@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:9:4@ @@ -554,8 +711,21 @@ foreign import ccall safe "hs_bindgen_df7e2b8e86de411a" quux1 :: MC -> __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_quux2@ -} -foreign import ccall safe "hs_bindgen_6f0b13ed02b696df" quux2 :: MC -> - CChar -> IO TC +quux2 = fromBaseForeignType quux2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f92059cc98dde342" wam1_base :: BaseForeignType (CFloat -> + Ptr TC -> + IO (Ptr MC)) +{-| __C declaration:__ @wam1@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:10:5@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam1@ +-} +wam1 :: CFloat -> Ptr TC -> IO (Ptr MC) {-| __C declaration:__ @wam1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:10:5@ @@ -564,8 +734,12 @@ foreign import ccall safe "hs_bindgen_6f0b13ed02b696df" quux2 :: MC -> __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam1@ -} -foreign import ccall safe "hs_bindgen_f92059cc98dde342" wam1 :: CFloat -> - Ptr TC -> IO (Ptr MC) +wam1 = fromBaseForeignType wam1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3e6ecd1b2cc616bc" wam2_base :: BaseForeignType (CFloat -> + Ptr MC -> + IO (Ptr TC)) {-| __C declaration:__ @wam2@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:11:5@ @@ -574,8 +748,21 @@ foreign import ccall safe "hs_bindgen_f92059cc98dde342" wam1 :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam2@ -} -foreign import ccall safe "hs_bindgen_3e6ecd1b2cc616bc" wam2 :: CFloat -> - Ptr MC -> IO (Ptr TC) +wam2 :: CFloat -> Ptr MC -> IO (Ptr TC) +{-| __C declaration:__ @wam2@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:11:5@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_wam2@ +-} +wam2 = fromBaseForeignType wam2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ffa9d5a3e8f0f221" struct_typedef1_base :: BaseForeignType (Ptr Struct2 -> + MC -> + IO Unit) {-| __C declaration:__ @struct_typedef1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:23:6@ @@ -584,8 +771,21 @@ foreign import ccall safe "hs_bindgen_3e6ecd1b2cc616bc" wam2 :: CFloat -> __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef1@ -} -foreign import ccall safe "hs_bindgen_ffa9d5a3e8f0f221" struct_typedef1 :: Ptr Struct2 -> - MC -> IO Unit +struct_typedef1 :: Ptr Struct2 -> MC -> IO Unit +{-| __C declaration:__ @struct_typedef1@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:23:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef1@ +-} +struct_typedef1 = fromBaseForeignType struct_typedef1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4801667560542114" struct_typedef2_base :: BaseForeignType (Ptr Struct3_t -> + MC -> + IO Unit) {-| __C declaration:__ @struct_typedef2@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:24:6@ @@ -594,8 +794,21 @@ foreign import ccall safe "hs_bindgen_ffa9d5a3e8f0f221" struct_typedef1 :: Ptr S __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef2@ -} -foreign import ccall safe "hs_bindgen_4801667560542114" struct_typedef2 :: Ptr Struct3_t -> - MC -> IO Unit +struct_typedef2 :: Ptr Struct3_t -> MC -> IO Unit +{-| __C declaration:__ @struct_typedef2@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:24:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef2@ +-} +struct_typedef2 = fromBaseForeignType struct_typedef2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_04fa5bbd479146eb" struct_typedef3_base :: BaseForeignType (Ptr Struct4 -> + MC -> + IO Unit) {-| __C declaration:__ @struct_typedef3@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:25:6@ @@ -604,8 +817,21 @@ foreign import ccall safe "hs_bindgen_4801667560542114" struct_typedef2 :: Ptr S __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef3@ -} -foreign import ccall safe "hs_bindgen_04fa5bbd479146eb" struct_typedef3 :: Ptr Struct4 -> - MC -> IO Unit +struct_typedef3 :: Ptr Struct4 -> MC -> IO Unit +{-| __C declaration:__ @struct_typedef3@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:25:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_typedef3@ +-} +struct_typedef3 = fromBaseForeignType struct_typedef3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_08025fd0bd589ac2" struct_name1_base :: BaseForeignType (Ptr Struct1 -> + MC -> + IO Unit) {-| __C declaration:__ @struct_name1@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:27:6@ @@ -614,8 +840,30 @@ foreign import ccall safe "hs_bindgen_04fa5bbd479146eb" struct_typedef3 :: Ptr S __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name1@ -} -foreign import ccall safe "hs_bindgen_08025fd0bd589ac2" struct_name1 :: Ptr Struct1 -> - MC -> IO Unit +struct_name1 :: Ptr Struct1 -> MC -> IO Unit +{-| __C declaration:__ @struct_name1@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:27:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name1@ +-} +struct_name1 = fromBaseForeignType struct_name1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9de286608f952fc7" struct_name2_base :: BaseForeignType (Ptr Struct3 -> + MC -> + IO Unit) +{-| __C declaration:__ @struct_name2@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:28:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name2@ +-} +struct_name2 :: Ptr Struct3 -> MC -> IO Unit {-| __C declaration:__ @struct_name2@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:28:6@ @@ -624,8 +872,12 @@ foreign import ccall safe "hs_bindgen_08025fd0bd589ac2" struct_name1 :: Ptr Stru __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name2@ -} -foreign import ccall safe "hs_bindgen_9de286608f952fc7" struct_name2 :: Ptr Struct3 -> - MC -> IO Unit +struct_name2 = fromBaseForeignType struct_name2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_38cce6bb1ac71578" struct_name3_base :: BaseForeignType (Ptr Struct4 -> + MC -> + IO Unit) {-| __C declaration:__ @struct_name3@ __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:29:6@ @@ -634,13 +886,27 @@ foreign import ccall safe "hs_bindgen_9de286608f952fc7" struct_name2 :: Ptr Stru __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name3@ -} -foreign import ccall safe "hs_bindgen_38cce6bb1ac71578" struct_name3 :: Ptr Struct4 -> - MC -> IO Unit +struct_name3 :: Ptr Struct4 -> MC -> IO Unit +{-| __C declaration:__ @struct_name3@ + + __defined at:__ @macros\/macro_in_fundecl_vs_typedef.h:29:6@ + + __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ + + __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_Unsafe_struct_name3@ +-} +struct_name3 = fromBaseForeignType struct_name3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fb1d9bc73e620f06" hs_bindgen_fb1d9bc73e620f06_base :: BaseForeignType (IO (FunPtr (MC -> + TC -> + IO CChar))) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_quux1_ptr@ -} -foreign import ccall safe "hs_bindgen_fb1d9bc73e620f06" hs_bindgen_fb1d9bc73e620f06 :: IO (FunPtr (MC -> - TC -> - IO CChar)) +hs_bindgen_fb1d9bc73e620f06 :: IO (FunPtr (MC -> TC -> IO CChar)) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_quux1_ptr@ +-} +hs_bindgen_fb1d9bc73e620f06 = fromBaseForeignType hs_bindgen_fb1d9bc73e620f06_base {-# NOINLINE quux1_ptr #-} {-| __C declaration:__ @quux1@ @@ -656,11 +922,17 @@ quux1_ptr :: FunPtr (MC -> TC -> IO CChar) __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ -} quux1_ptr = unsafePerformIO hs_bindgen_fb1d9bc73e620f06 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9dc824587cab07a2" hs_bindgen_9dc824587cab07a2_base :: BaseForeignType (IO (FunPtr (MC -> + CChar -> + IO TC))) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_quux2_ptr@ -} -foreign import ccall safe "hs_bindgen_9dc824587cab07a2" hs_bindgen_9dc824587cab07a2 :: IO (FunPtr (MC -> - CChar -> - IO TC)) +hs_bindgen_9dc824587cab07a2 :: IO (FunPtr (MC -> CChar -> IO TC)) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_quux2_ptr@ +-} +hs_bindgen_9dc824587cab07a2 = fromBaseForeignType hs_bindgen_9dc824587cab07a2_base {-# NOINLINE quux2_ptr #-} {-| __C declaration:__ @quux2@ @@ -676,11 +948,18 @@ quux2_ptr :: FunPtr (MC -> CChar -> IO TC) __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ -} quux2_ptr = unsafePerformIO hs_bindgen_9dc824587cab07a2 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_03d794639e412075" hs_bindgen_03d794639e412075_base :: BaseForeignType (IO (FunPtr (CFloat -> + Ptr TC -> + IO (Ptr MC)))) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_wam1_ptr@ -} -foreign import ccall safe "hs_bindgen_03d794639e412075" hs_bindgen_03d794639e412075 :: IO (FunPtr (CFloat -> - Ptr TC -> - IO (Ptr MC))) +hs_bindgen_03d794639e412075 :: IO (FunPtr (CFloat -> + Ptr TC -> IO (Ptr MC))) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_wam1_ptr@ +-} +hs_bindgen_03d794639e412075 = fromBaseForeignType hs_bindgen_03d794639e412075_base {-# NOINLINE wam1_ptr #-} {-| __C declaration:__ @wam1@ @@ -696,11 +975,18 @@ wam1_ptr :: FunPtr (CFloat -> Ptr TC -> IO (Ptr MC)) __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ -} wam1_ptr = unsafePerformIO hs_bindgen_03d794639e412075 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0a5eb04fc739212a" hs_bindgen_0a5eb04fc739212a_base :: BaseForeignType (IO (FunPtr (CFloat -> + Ptr MC -> + IO (Ptr TC)))) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_wam2_ptr@ -} -foreign import ccall safe "hs_bindgen_0a5eb04fc739212a" hs_bindgen_0a5eb04fc739212a :: IO (FunPtr (CFloat -> - Ptr MC -> - IO (Ptr TC))) +hs_bindgen_0a5eb04fc739212a :: IO (FunPtr (CFloat -> + Ptr MC -> IO (Ptr TC))) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_wam2_ptr@ +-} +hs_bindgen_0a5eb04fc739212a = fromBaseForeignType hs_bindgen_0a5eb04fc739212a_base {-# NOINLINE wam2_ptr #-} {-| __C declaration:__ @wam2@ @@ -716,11 +1002,18 @@ wam2_ptr :: FunPtr (CFloat -> Ptr MC -> IO (Ptr TC)) __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ -} wam2_ptr = unsafePerformIO hs_bindgen_0a5eb04fc739212a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6d4f35a86a00c68b" hs_bindgen_6d4f35a86a00c68b_base :: BaseForeignType (IO (FunPtr (Ptr Struct2 -> + MC -> + IO Unit))) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_typedef1_ptr@ +-} +hs_bindgen_6d4f35a86a00c68b :: IO (FunPtr (Ptr Struct2 -> + MC -> IO Unit)) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_typedef1_ptr@ -} -foreign import ccall safe "hs_bindgen_6d4f35a86a00c68b" hs_bindgen_6d4f35a86a00c68b :: IO (FunPtr (Ptr Struct2 -> - MC -> - IO Unit)) +hs_bindgen_6d4f35a86a00c68b = fromBaseForeignType hs_bindgen_6d4f35a86a00c68b_base {-# NOINLINE struct_typedef1_ptr #-} {-| __C declaration:__ @struct_typedef1@ @@ -736,11 +1029,18 @@ struct_typedef1_ptr :: FunPtr (Ptr Struct2 -> MC -> IO Unit) __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ -} struct_typedef1_ptr = unsafePerformIO hs_bindgen_6d4f35a86a00c68b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_af92d1197a77fe13" hs_bindgen_af92d1197a77fe13_base :: BaseForeignType (IO (FunPtr (Ptr Struct3_t -> + MC -> + IO Unit))) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_typedef2_ptr@ +-} +hs_bindgen_af92d1197a77fe13 :: IO (FunPtr (Ptr Struct3_t -> + MC -> IO Unit)) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_typedef2_ptr@ -} -foreign import ccall safe "hs_bindgen_af92d1197a77fe13" hs_bindgen_af92d1197a77fe13 :: IO (FunPtr (Ptr Struct3_t -> - MC -> - IO Unit)) +hs_bindgen_af92d1197a77fe13 = fromBaseForeignType hs_bindgen_af92d1197a77fe13_base {-# NOINLINE struct_typedef2_ptr #-} {-| __C declaration:__ @struct_typedef2@ @@ -756,11 +1056,18 @@ struct_typedef2_ptr :: FunPtr (Ptr Struct3_t -> MC -> IO Unit) __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ -} struct_typedef2_ptr = unsafePerformIO hs_bindgen_af92d1197a77fe13 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c5effcd02d3d5efd" hs_bindgen_c5effcd02d3d5efd_base :: BaseForeignType (IO (FunPtr (Ptr Struct4 -> + MC -> + IO Unit))) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_typedef3_ptr@ +-} +hs_bindgen_c5effcd02d3d5efd :: IO (FunPtr (Ptr Struct4 -> + MC -> IO Unit)) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_typedef3_ptr@ -} -foreign import ccall safe "hs_bindgen_c5effcd02d3d5efd" hs_bindgen_c5effcd02d3d5efd :: IO (FunPtr (Ptr Struct4 -> - MC -> - IO Unit)) +hs_bindgen_c5effcd02d3d5efd = fromBaseForeignType hs_bindgen_c5effcd02d3d5efd_base {-# NOINLINE struct_typedef3_ptr #-} {-| __C declaration:__ @struct_typedef3@ @@ -776,11 +1083,18 @@ struct_typedef3_ptr :: FunPtr (Ptr Struct4 -> MC -> IO Unit) __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ -} struct_typedef3_ptr = unsafePerformIO hs_bindgen_c5effcd02d3d5efd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_842a0d61a7a895d6" hs_bindgen_842a0d61a7a895d6_base :: BaseForeignType (IO (FunPtr (Ptr Struct1 -> + MC -> + IO Unit))) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_name1_ptr@ +-} +hs_bindgen_842a0d61a7a895d6 :: IO (FunPtr (Ptr Struct1 -> + MC -> IO Unit)) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_name1_ptr@ -} -foreign import ccall safe "hs_bindgen_842a0d61a7a895d6" hs_bindgen_842a0d61a7a895d6 :: IO (FunPtr (Ptr Struct1 -> - MC -> - IO Unit)) +hs_bindgen_842a0d61a7a895d6 = fromBaseForeignType hs_bindgen_842a0d61a7a895d6_base {-# NOINLINE struct_name1_ptr #-} {-| __C declaration:__ @struct_name1@ @@ -796,11 +1110,18 @@ struct_name1_ptr :: FunPtr (Ptr Struct1 -> MC -> IO Unit) __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ -} struct_name1_ptr = unsafePerformIO hs_bindgen_842a0d61a7a895d6 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ead25a696827a8f7" hs_bindgen_ead25a696827a8f7_base :: BaseForeignType (IO (FunPtr (Ptr Struct3 -> + MC -> + IO Unit))) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_name2_ptr@ +-} +hs_bindgen_ead25a696827a8f7 :: IO (FunPtr (Ptr Struct3 -> + MC -> IO Unit)) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_name2_ptr@ -} -foreign import ccall safe "hs_bindgen_ead25a696827a8f7" hs_bindgen_ead25a696827a8f7 :: IO (FunPtr (Ptr Struct3 -> - MC -> - IO Unit)) +hs_bindgen_ead25a696827a8f7 = fromBaseForeignType hs_bindgen_ead25a696827a8f7_base {-# NOINLINE struct_name2_ptr #-} {-| __C declaration:__ @struct_name2@ @@ -816,11 +1137,18 @@ struct_name2_ptr :: FunPtr (Ptr Struct3 -> MC -> IO Unit) __exported by:__ @macros\/macro_in_fundecl_vs_typedef.h@ -} struct_name2_ptr = unsafePerformIO hs_bindgen_ead25a696827a8f7 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_680e8a5d673ce9c1" hs_bindgen_680e8a5d673ce9c1_base :: BaseForeignType (IO (FunPtr (Ptr Struct4 -> + MC -> + IO Unit))) +{-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_name3_ptr@ +-} +hs_bindgen_680e8a5d673ce9c1 :: IO (FunPtr (Ptr Struct4 -> + MC -> IO Unit)) {-| __unique:__ @test_macrosmacro_in_fundecl_vs_typ_Example_get_struct_name3_ptr@ -} -foreign import ccall safe "hs_bindgen_680e8a5d673ce9c1" hs_bindgen_680e8a5d673ce9c1 :: IO (FunPtr (Ptr Struct4 -> - MC -> - IO Unit)) +hs_bindgen_680e8a5d673ce9c1 = fromBaseForeignType hs_bindgen_680e8a5d673ce9c1_base {-# NOINLINE struct_name3_ptr #-} {-| __C declaration:__ @struct_name3@ diff --git a/hs-bindgen/fixtures/macros/reparse/Example/FunPtr.hs b/hs-bindgen/fixtures/macros/reparse/Example/FunPtr.hs index 3f2cb7e58..11a19a21c 100644 --- a/hs-bindgen/fixtures/macros/reparse/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/macros/reparse/Example/FunPtr.hs @@ -11,6 +11,7 @@ import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) @@ -990,10 +991,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_83aaba90c800683a" hs_bindgen_83aaba90c800683a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CChar -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_char1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_83aaba90c800683a" hs_bindgen_83aaba90c800683a :: +hs_bindgen_83aaba90c800683a :: IO (Ptr.FunPtr (A -> FC.CChar -> IO ())) +hs_bindgen_83aaba90c800683a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_83aaba90c800683a_base {-# NOINLINE args_char1_ptr #-} @@ -1009,10 +1017,17 @@ args_char1_ptr :: Ptr.FunPtr (A -> FC.CChar -> IO ()) args_char1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_83aaba90c800683a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e7c58099a677e598" hs_bindgen_e7c58099a677e598_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CSChar -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_char2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e7c58099a677e598" hs_bindgen_e7c58099a677e598 :: +hs_bindgen_e7c58099a677e598 :: IO (Ptr.FunPtr (A -> FC.CSChar -> IO ())) +hs_bindgen_e7c58099a677e598 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e7c58099a677e598_base {-# NOINLINE args_char2_ptr #-} @@ -1026,10 +1041,17 @@ args_char2_ptr :: Ptr.FunPtr (A -> FC.CSChar -> IO ()) args_char2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e7c58099a677e598 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cc33f1bf42bb14f7" hs_bindgen_cc33f1bf42bb14f7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CUChar -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_char3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_cc33f1bf42bb14f7" hs_bindgen_cc33f1bf42bb14f7 :: +hs_bindgen_cc33f1bf42bb14f7 :: IO (Ptr.FunPtr (A -> FC.CUChar -> IO ())) +hs_bindgen_cc33f1bf42bb14f7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_cc33f1bf42bb14f7_base {-# NOINLINE args_char3_ptr #-} @@ -1043,10 +1065,17 @@ args_char3_ptr :: Ptr.FunPtr (A -> FC.CUChar -> IO ()) args_char3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_cc33f1bf42bb14f7 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_daf63941377bc30d" hs_bindgen_daf63941377bc30d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CShort -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_short1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_daf63941377bc30d" hs_bindgen_daf63941377bc30d :: +hs_bindgen_daf63941377bc30d :: IO (Ptr.FunPtr (A -> FC.CShort -> IO ())) +hs_bindgen_daf63941377bc30d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_daf63941377bc30d_base {-# NOINLINE args_short1_ptr #-} @@ -1060,10 +1089,17 @@ args_short1_ptr :: Ptr.FunPtr (A -> FC.CShort -> IO ()) args_short1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_daf63941377bc30d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f832e83c66e73e1b" hs_bindgen_f832e83c66e73e1b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CShort -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_short2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f832e83c66e73e1b" hs_bindgen_f832e83c66e73e1b :: +hs_bindgen_f832e83c66e73e1b :: IO (Ptr.FunPtr (A -> FC.CShort -> IO ())) +hs_bindgen_f832e83c66e73e1b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f832e83c66e73e1b_base {-# NOINLINE args_short2_ptr #-} @@ -1077,10 +1113,17 @@ args_short2_ptr :: Ptr.FunPtr (A -> FC.CShort -> IO ()) args_short2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f832e83c66e73e1b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fddcd4eb9a3ac90f" hs_bindgen_fddcd4eb9a3ac90f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CUShort -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_short3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_fddcd4eb9a3ac90f" hs_bindgen_fddcd4eb9a3ac90f :: +hs_bindgen_fddcd4eb9a3ac90f :: IO (Ptr.FunPtr (A -> FC.CUShort -> IO ())) +hs_bindgen_fddcd4eb9a3ac90f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_fddcd4eb9a3ac90f_base {-# NOINLINE args_short3_ptr #-} @@ -1094,10 +1137,17 @@ args_short3_ptr :: Ptr.FunPtr (A -> FC.CUShort -> IO ()) args_short3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_fddcd4eb9a3ac90f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8f495550fa03ecd7" hs_bindgen_8f495550fa03ecd7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CInt -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_int1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8f495550fa03ecd7" hs_bindgen_8f495550fa03ecd7 :: +hs_bindgen_8f495550fa03ecd7 :: IO (Ptr.FunPtr (A -> FC.CInt -> IO ())) +hs_bindgen_8f495550fa03ecd7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8f495550fa03ecd7_base {-# NOINLINE args_int1_ptr #-} @@ -1111,10 +1161,17 @@ args_int1_ptr :: Ptr.FunPtr (A -> FC.CInt -> IO ()) args_int1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8f495550fa03ecd7 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_488a7dcf2bd33678" hs_bindgen_488a7dcf2bd33678_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CInt -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_int2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_488a7dcf2bd33678" hs_bindgen_488a7dcf2bd33678 :: +hs_bindgen_488a7dcf2bd33678 :: IO (Ptr.FunPtr (A -> FC.CInt -> IO ())) +hs_bindgen_488a7dcf2bd33678 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_488a7dcf2bd33678_base {-# NOINLINE args_int2_ptr #-} @@ -1128,10 +1185,17 @@ args_int2_ptr :: Ptr.FunPtr (A -> FC.CInt -> IO ()) args_int2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_488a7dcf2bd33678 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5c6e85e96378ce0f" hs_bindgen_5c6e85e96378ce0f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CUInt -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_int3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_5c6e85e96378ce0f" hs_bindgen_5c6e85e96378ce0f :: +hs_bindgen_5c6e85e96378ce0f :: IO (Ptr.FunPtr (A -> FC.CUInt -> IO ())) +hs_bindgen_5c6e85e96378ce0f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_5c6e85e96378ce0f_base {-# NOINLINE args_int3_ptr #-} @@ -1145,10 +1209,17 @@ args_int3_ptr :: Ptr.FunPtr (A -> FC.CUInt -> IO ()) args_int3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_5c6e85e96378ce0f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_afcad03e61d3f83b" hs_bindgen_afcad03e61d3f83b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CLong -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_long1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_afcad03e61d3f83b" hs_bindgen_afcad03e61d3f83b :: +hs_bindgen_afcad03e61d3f83b :: IO (Ptr.FunPtr (A -> FC.CLong -> IO ())) +hs_bindgen_afcad03e61d3f83b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_afcad03e61d3f83b_base {-# NOINLINE args_long1_ptr #-} @@ -1162,10 +1233,17 @@ args_long1_ptr :: Ptr.FunPtr (A -> FC.CLong -> IO ()) args_long1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_afcad03e61d3f83b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2d32bae595df94c2" hs_bindgen_2d32bae595df94c2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CLong -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_long2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2d32bae595df94c2" hs_bindgen_2d32bae595df94c2 :: +hs_bindgen_2d32bae595df94c2 :: IO (Ptr.FunPtr (A -> FC.CLong -> IO ())) +hs_bindgen_2d32bae595df94c2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2d32bae595df94c2_base {-# NOINLINE args_long2_ptr #-} @@ -1179,10 +1257,17 @@ args_long2_ptr :: Ptr.FunPtr (A -> FC.CLong -> IO ()) args_long2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2d32bae595df94c2 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0f7d316338eac027" hs_bindgen_0f7d316338eac027_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CULong -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_long3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_0f7d316338eac027" hs_bindgen_0f7d316338eac027 :: +hs_bindgen_0f7d316338eac027 :: IO (Ptr.FunPtr (A -> FC.CULong -> IO ())) +hs_bindgen_0f7d316338eac027 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_0f7d316338eac027_base {-# NOINLINE args_long3_ptr #-} @@ -1196,10 +1281,17 @@ args_long3_ptr :: Ptr.FunPtr (A -> FC.CULong -> IO ()) args_long3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_0f7d316338eac027 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9ed3dd630c6a5c91" hs_bindgen_9ed3dd630c6a5c91_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CFloat -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_float_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9ed3dd630c6a5c91" hs_bindgen_9ed3dd630c6a5c91 :: +hs_bindgen_9ed3dd630c6a5c91 :: IO (Ptr.FunPtr (A -> FC.CFloat -> IO ())) +hs_bindgen_9ed3dd630c6a5c91 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9ed3dd630c6a5c91_base {-# NOINLINE args_float_ptr #-} @@ -1213,10 +1305,17 @@ args_float_ptr :: Ptr.FunPtr (A -> FC.CFloat -> IO ()) args_float_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9ed3dd630c6a5c91 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c1afad204f639896" hs_bindgen_c1afad204f639896_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CDouble -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_double_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c1afad204f639896" hs_bindgen_c1afad204f639896 :: +hs_bindgen_c1afad204f639896 :: IO (Ptr.FunPtr (A -> FC.CDouble -> IO ())) +hs_bindgen_c1afad204f639896 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c1afad204f639896_base {-# NOINLINE args_double_ptr #-} @@ -1230,10 +1329,17 @@ args_double_ptr :: Ptr.FunPtr (A -> FC.CDouble -> IO ()) args_double_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c1afad204f639896 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c7091d8aa6313541" hs_bindgen_c7091d8aa6313541_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CBool -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_bool1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c7091d8aa6313541" hs_bindgen_c7091d8aa6313541 :: +hs_bindgen_c7091d8aa6313541 :: IO (Ptr.FunPtr (A -> FC.CBool -> IO ())) +hs_bindgen_c7091d8aa6313541 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c7091d8aa6313541_base {-# NOINLINE args_bool1_ptr #-} @@ -1247,10 +1353,17 @@ args_bool1_ptr :: Ptr.FunPtr (A -> FC.CBool -> IO ()) args_bool1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c7091d8aa6313541 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c14722de6f25d3c0" hs_bindgen_c14722de6f25d3c0_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> Some_struct -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_struct_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c14722de6f25d3c0" hs_bindgen_c14722de6f25d3c0 :: +hs_bindgen_c14722de6f25d3c0 :: IO (Ptr.FunPtr (A -> Some_struct -> IO ())) +hs_bindgen_c14722de6f25d3c0 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c14722de6f25d3c0_base {-# NOINLINE args_struct_ptr #-} @@ -1264,10 +1377,17 @@ args_struct_ptr :: Ptr.FunPtr (A -> Some_struct -> IO ()) args_struct_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c14722de6f25d3c0 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a94ca07a5083d898" hs_bindgen_a94ca07a5083d898_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> Some_union -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_union_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a94ca07a5083d898" hs_bindgen_a94ca07a5083d898 :: +hs_bindgen_a94ca07a5083d898 :: IO (Ptr.FunPtr (A -> Some_union -> IO ())) +hs_bindgen_a94ca07a5083d898 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a94ca07a5083d898_base {-# NOINLINE args_union_ptr #-} @@ -1281,10 +1401,17 @@ args_union_ptr :: Ptr.FunPtr (A -> Some_union -> IO ()) args_union_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a94ca07a5083d898 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2fdbcc2976b884f7" hs_bindgen_2fdbcc2976b884f7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> Some_enum -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_enum_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2fdbcc2976b884f7" hs_bindgen_2fdbcc2976b884f7 :: +hs_bindgen_2fdbcc2976b884f7 :: IO (Ptr.FunPtr (A -> Some_enum -> IO ())) +hs_bindgen_2fdbcc2976b884f7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2fdbcc2976b884f7_base {-# NOINLINE args_enum_ptr #-} @@ -1298,10 +1425,17 @@ args_enum_ptr :: Ptr.FunPtr (A -> Some_enum -> IO ()) args_enum_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2fdbcc2976b884f7 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_65b8da715d77e581" hs_bindgen_65b8da715d77e581_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_pointer1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_65b8da715d77e581" hs_bindgen_65b8da715d77e581 :: +hs_bindgen_65b8da715d77e581 :: IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ())) +hs_bindgen_65b8da715d77e581 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_65b8da715d77e581_base {-# NOINLINE args_pointer1_ptr #-} @@ -1315,10 +1449,17 @@ args_pointer1_ptr :: Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()) args_pointer1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_65b8da715d77e581 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_767fe5b679ba43e4" hs_bindgen_767fe5b679ba43e4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.Ptr (Ptr.Ptr FC.CInt)) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_pointer2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_767fe5b679ba43e4" hs_bindgen_767fe5b679ba43e4 :: +hs_bindgen_767fe5b679ba43e4 :: IO (Ptr.FunPtr (A -> (Ptr.Ptr (Ptr.Ptr FC.CInt)) -> IO ())) +hs_bindgen_767fe5b679ba43e4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_767fe5b679ba43e4_base {-# NOINLINE args_pointer2_ptr #-} @@ -1332,10 +1473,17 @@ args_pointer2_ptr :: Ptr.FunPtr (A -> (Ptr.Ptr (Ptr.Ptr FC.CInt)) -> IO ()) args_pointer2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_767fe5b679ba43e4 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_852cc5784297324b" hs_bindgen_852cc5784297324b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.Ptr Void) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_pointer3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_852cc5784297324b" hs_bindgen_852cc5784297324b :: +hs_bindgen_852cc5784297324b :: IO (Ptr.FunPtr (A -> (Ptr.Ptr Void) -> IO ())) +hs_bindgen_852cc5784297324b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_852cc5784297324b_base {-# NOINLINE args_pointer3_ptr #-} @@ -1349,10 +1497,17 @@ args_pointer3_ptr :: Ptr.FunPtr (A -> (Ptr.Ptr Void) -> IO ()) args_pointer3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_852cc5784297324b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_89cbc210fb67bc53" hs_bindgen_89cbc210fb67bc53_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO A))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_A_ptr@ -} -foreign import ccall unsafe "hs_bindgen_89cbc210fb67bc53" hs_bindgen_89cbc210fb67bc53 :: +hs_bindgen_89cbc210fb67bc53 :: IO (Ptr.FunPtr (IO A)) +hs_bindgen_89cbc210fb67bc53 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_89cbc210fb67bc53_base {-# NOINLINE ret_A_ptr #-} @@ -1366,10 +1521,17 @@ ret_A_ptr :: Ptr.FunPtr (IO A) ret_A_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_89cbc210fb67bc53 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d95a16b3f46326f5" hs_bindgen_d95a16b3f46326f5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CChar))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_char1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d95a16b3f46326f5" hs_bindgen_d95a16b3f46326f5 :: +hs_bindgen_d95a16b3f46326f5 :: IO (Ptr.FunPtr (A -> IO FC.CChar)) +hs_bindgen_d95a16b3f46326f5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d95a16b3f46326f5_base {-# NOINLINE ret_char1_ptr #-} @@ -1383,10 +1545,17 @@ ret_char1_ptr :: Ptr.FunPtr (A -> IO FC.CChar) ret_char1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d95a16b3f46326f5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dbb14b4445c045dc" hs_bindgen_dbb14b4445c045dc_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CSChar))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_char2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_dbb14b4445c045dc" hs_bindgen_dbb14b4445c045dc :: +hs_bindgen_dbb14b4445c045dc :: IO (Ptr.FunPtr (A -> IO FC.CSChar)) +hs_bindgen_dbb14b4445c045dc = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_dbb14b4445c045dc_base {-# NOINLINE ret_char2_ptr #-} @@ -1400,10 +1569,17 @@ ret_char2_ptr :: Ptr.FunPtr (A -> IO FC.CSChar) ret_char2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_dbb14b4445c045dc +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_18d70300449e2a05" hs_bindgen_18d70300449e2a05_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CUChar))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_char3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_18d70300449e2a05" hs_bindgen_18d70300449e2a05 :: +hs_bindgen_18d70300449e2a05 :: IO (Ptr.FunPtr (A -> IO FC.CUChar)) +hs_bindgen_18d70300449e2a05 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_18d70300449e2a05_base {-# NOINLINE ret_char3_ptr #-} @@ -1417,10 +1593,17 @@ ret_char3_ptr :: Ptr.FunPtr (A -> IO FC.CUChar) ret_char3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_18d70300449e2a05 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7f113070dda67da8" hs_bindgen_7f113070dda67da8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CShort))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_short1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7f113070dda67da8" hs_bindgen_7f113070dda67da8 :: +hs_bindgen_7f113070dda67da8 :: IO (Ptr.FunPtr (A -> IO FC.CShort)) +hs_bindgen_7f113070dda67da8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7f113070dda67da8_base {-# NOINLINE ret_short1_ptr #-} @@ -1434,10 +1617,17 @@ ret_short1_ptr :: Ptr.FunPtr (A -> IO FC.CShort) ret_short1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7f113070dda67da8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_601d9c0a30f1855b" hs_bindgen_601d9c0a30f1855b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CShort))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_short2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_601d9c0a30f1855b" hs_bindgen_601d9c0a30f1855b :: +hs_bindgen_601d9c0a30f1855b :: IO (Ptr.FunPtr (A -> IO FC.CShort)) +hs_bindgen_601d9c0a30f1855b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_601d9c0a30f1855b_base {-# NOINLINE ret_short2_ptr #-} @@ -1451,10 +1641,17 @@ ret_short2_ptr :: Ptr.FunPtr (A -> IO FC.CShort) ret_short2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_601d9c0a30f1855b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_eb1f70424e0c701d" hs_bindgen_eb1f70424e0c701d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CUShort))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_short3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_eb1f70424e0c701d" hs_bindgen_eb1f70424e0c701d :: +hs_bindgen_eb1f70424e0c701d :: IO (Ptr.FunPtr (A -> IO FC.CUShort)) +hs_bindgen_eb1f70424e0c701d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_eb1f70424e0c701d_base {-# NOINLINE ret_short3_ptr #-} @@ -1468,10 +1665,17 @@ ret_short3_ptr :: Ptr.FunPtr (A -> IO FC.CUShort) ret_short3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_eb1f70424e0c701d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_28a93ce9f2a99cd0" hs_bindgen_28a93ce9f2a99cd0_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CInt))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_int1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_28a93ce9f2a99cd0" hs_bindgen_28a93ce9f2a99cd0 :: +hs_bindgen_28a93ce9f2a99cd0 :: IO (Ptr.FunPtr (A -> IO FC.CInt)) +hs_bindgen_28a93ce9f2a99cd0 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_28a93ce9f2a99cd0_base {-# NOINLINE ret_int1_ptr #-} @@ -1485,10 +1689,17 @@ ret_int1_ptr :: Ptr.FunPtr (A -> IO FC.CInt) ret_int1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_28a93ce9f2a99cd0 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a70295d21f766087" hs_bindgen_a70295d21f766087_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CInt))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_int2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a70295d21f766087" hs_bindgen_a70295d21f766087 :: +hs_bindgen_a70295d21f766087 :: IO (Ptr.FunPtr (A -> IO FC.CInt)) +hs_bindgen_a70295d21f766087 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a70295d21f766087_base {-# NOINLINE ret_int2_ptr #-} @@ -1502,10 +1713,17 @@ ret_int2_ptr :: Ptr.FunPtr (A -> IO FC.CInt) ret_int2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a70295d21f766087 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4239c3dd15ab11f3" hs_bindgen_4239c3dd15ab11f3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CUInt))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_int3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4239c3dd15ab11f3" hs_bindgen_4239c3dd15ab11f3 :: +hs_bindgen_4239c3dd15ab11f3 :: IO (Ptr.FunPtr (A -> IO FC.CUInt)) +hs_bindgen_4239c3dd15ab11f3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4239c3dd15ab11f3_base {-# NOINLINE ret_int3_ptr #-} @@ -1519,10 +1737,17 @@ ret_int3_ptr :: Ptr.FunPtr (A -> IO FC.CUInt) ret_int3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4239c3dd15ab11f3 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b24935761b06cfd8" hs_bindgen_b24935761b06cfd8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CLong))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_long1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b24935761b06cfd8" hs_bindgen_b24935761b06cfd8 :: +hs_bindgen_b24935761b06cfd8 :: IO (Ptr.FunPtr (A -> IO FC.CLong)) +hs_bindgen_b24935761b06cfd8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b24935761b06cfd8_base {-# NOINLINE ret_long1_ptr #-} @@ -1536,10 +1761,17 @@ ret_long1_ptr :: Ptr.FunPtr (A -> IO FC.CLong) ret_long1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_b24935761b06cfd8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_35a17cc5266d3326" hs_bindgen_35a17cc5266d3326_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CLong))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_long2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_35a17cc5266d3326" hs_bindgen_35a17cc5266d3326 :: +hs_bindgen_35a17cc5266d3326 :: IO (Ptr.FunPtr (A -> IO FC.CLong)) +hs_bindgen_35a17cc5266d3326 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_35a17cc5266d3326_base {-# NOINLINE ret_long2_ptr #-} @@ -1553,10 +1785,17 @@ ret_long2_ptr :: Ptr.FunPtr (A -> IO FC.CLong) ret_long2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_35a17cc5266d3326 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_59489620015c271e" hs_bindgen_59489620015c271e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CULong))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_long3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_59489620015c271e" hs_bindgen_59489620015c271e :: +hs_bindgen_59489620015c271e :: IO (Ptr.FunPtr (A -> IO FC.CULong)) +hs_bindgen_59489620015c271e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_59489620015c271e_base {-# NOINLINE ret_long3_ptr #-} @@ -1570,10 +1809,17 @@ ret_long3_ptr :: Ptr.FunPtr (A -> IO FC.CULong) ret_long3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_59489620015c271e +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_52138c45b539427d" hs_bindgen_52138c45b539427d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CFloat))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_float_ptr@ -} -foreign import ccall unsafe "hs_bindgen_52138c45b539427d" hs_bindgen_52138c45b539427d :: +hs_bindgen_52138c45b539427d :: IO (Ptr.FunPtr (A -> IO FC.CFloat)) +hs_bindgen_52138c45b539427d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_52138c45b539427d_base {-# NOINLINE ret_float_ptr #-} @@ -1587,10 +1833,17 @@ ret_float_ptr :: Ptr.FunPtr (A -> IO FC.CFloat) ret_float_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_52138c45b539427d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_283d5d098a9c4a59" hs_bindgen_283d5d098a9c4a59_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CDouble))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_double_ptr@ -} -foreign import ccall unsafe "hs_bindgen_283d5d098a9c4a59" hs_bindgen_283d5d098a9c4a59 :: +hs_bindgen_283d5d098a9c4a59 :: IO (Ptr.FunPtr (A -> IO FC.CDouble)) +hs_bindgen_283d5d098a9c4a59 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_283d5d098a9c4a59_base {-# NOINLINE ret_double_ptr #-} @@ -1604,10 +1857,17 @@ ret_double_ptr :: Ptr.FunPtr (A -> IO FC.CDouble) ret_double_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_283d5d098a9c4a59 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_382098412cbd94ff" hs_bindgen_382098412cbd94ff_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CBool))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_bool1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_382098412cbd94ff" hs_bindgen_382098412cbd94ff :: +hs_bindgen_382098412cbd94ff :: IO (Ptr.FunPtr (A -> IO FC.CBool)) +hs_bindgen_382098412cbd94ff = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_382098412cbd94ff_base {-# NOINLINE ret_bool1_ptr #-} @@ -1621,10 +1881,17 @@ ret_bool1_ptr :: Ptr.FunPtr (A -> IO FC.CBool) ret_bool1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_382098412cbd94ff +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_51cf9857b3cc1843" hs_bindgen_51cf9857b3cc1843_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO Some_struct))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_struct_ptr@ -} -foreign import ccall unsafe "hs_bindgen_51cf9857b3cc1843" hs_bindgen_51cf9857b3cc1843 :: +hs_bindgen_51cf9857b3cc1843 :: IO (Ptr.FunPtr (A -> IO Some_struct)) +hs_bindgen_51cf9857b3cc1843 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_51cf9857b3cc1843_base {-# NOINLINE ret_struct_ptr #-} @@ -1638,10 +1905,17 @@ ret_struct_ptr :: Ptr.FunPtr (A -> IO Some_struct) ret_struct_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_51cf9857b3cc1843 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3df1073dbf5d79f4" hs_bindgen_3df1073dbf5d79f4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO Some_union))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_union_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3df1073dbf5d79f4" hs_bindgen_3df1073dbf5d79f4 :: +hs_bindgen_3df1073dbf5d79f4 :: IO (Ptr.FunPtr (A -> IO Some_union)) +hs_bindgen_3df1073dbf5d79f4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3df1073dbf5d79f4_base {-# NOINLINE ret_union_ptr #-} @@ -1655,10 +1929,17 @@ ret_union_ptr :: Ptr.FunPtr (A -> IO Some_union) ret_union_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3df1073dbf5d79f4 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c0467f7279732ddd" hs_bindgen_c0467f7279732ddd_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO Some_enum))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_enum_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c0467f7279732ddd" hs_bindgen_c0467f7279732ddd :: +hs_bindgen_c0467f7279732ddd :: IO (Ptr.FunPtr (A -> IO Some_enum)) +hs_bindgen_c0467f7279732ddd = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c0467f7279732ddd_base {-# NOINLINE ret_enum_ptr #-} @@ -1672,10 +1953,17 @@ ret_enum_ptr :: Ptr.FunPtr (A -> IO Some_enum) ret_enum_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c0467f7279732ddd +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f0240baaa70df9bd" hs_bindgen_f0240baaa70df9bd_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_pointer1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f0240baaa70df9bd" hs_bindgen_f0240baaa70df9bd :: +hs_bindgen_f0240baaa70df9bd :: IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt))) +hs_bindgen_f0240baaa70df9bd = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f0240baaa70df9bd_base {-# NOINLINE ret_pointer1_ptr #-} @@ -1689,10 +1977,17 @@ ret_pointer1_ptr :: Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)) ret_pointer1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f0240baaa70df9bd +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_019cbfb4d24d1d91" hs_bindgen_019cbfb4d24d1d91_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.Ptr (Ptr.Ptr FC.CInt))))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_pointer2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_019cbfb4d24d1d91" hs_bindgen_019cbfb4d24d1d91 :: +hs_bindgen_019cbfb4d24d1d91 :: IO (Ptr.FunPtr (A -> IO (Ptr.Ptr (Ptr.Ptr FC.CInt)))) +hs_bindgen_019cbfb4d24d1d91 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_019cbfb4d24d1d91_base {-# NOINLINE ret_pointer2_ptr #-} @@ -1706,10 +2001,17 @@ ret_pointer2_ptr :: Ptr.FunPtr (A -> IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) ret_pointer2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_019cbfb4d24d1d91 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a654e9f8ca0d53c5" hs_bindgen_a654e9f8ca0d53c5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.Ptr Void)))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_pointer3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a654e9f8ca0d53c5" hs_bindgen_a654e9f8ca0d53c5 :: +hs_bindgen_a654e9f8ca0d53c5 :: IO (Ptr.FunPtr (A -> IO (Ptr.Ptr Void))) +hs_bindgen_a654e9f8ca0d53c5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a654e9f8ca0d53c5_base {-# NOINLINE ret_pointer3_ptr #-} @@ -1723,10 +2025,17 @@ ret_pointer3_ptr :: Ptr.FunPtr (A -> IO (Ptr.Ptr Void)) ret_pointer3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a654e9f8ca0d53c5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_94eff7815581584b" hs_bindgen_94eff7815581584b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CInt))) + {-| __unique:__ @test_macrosreparse_Example_get_body1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_94eff7815581584b" hs_bindgen_94eff7815581584b :: +hs_bindgen_94eff7815581584b :: IO (Ptr.FunPtr (A -> IO FC.CInt)) +hs_bindgen_94eff7815581584b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_94eff7815581584b_base {-# NOINLINE body1_ptr #-} @@ -1740,10 +2049,17 @@ body1_ptr :: Ptr.FunPtr (A -> IO FC.CInt) body1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_94eff7815581584b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f98b0963b05f261c" hs_bindgen_f98b0963b05f261c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO A))) + {-| __unique:__ @test_macrosreparse_Example_get_body2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f98b0963b05f261c" hs_bindgen_f98b0963b05f261c :: +hs_bindgen_f98b0963b05f261c :: IO (Ptr.FunPtr (IO A)) +hs_bindgen_f98b0963b05f261c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f98b0963b05f261c_base {-# NOINLINE body2_ptr #-} @@ -1757,10 +2073,17 @@ body2_ptr :: Ptr.FunPtr (IO A) body2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f98b0963b05f261c +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e2f3985767c79559" hs_bindgen_e2f3985767c79559_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Data.Complex.Complex FC.CFloat) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_complex_float_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e2f3985767c79559" hs_bindgen_e2f3985767c79559 :: +hs_bindgen_e2f3985767c79559 :: IO (Ptr.FunPtr (A -> (Data.Complex.Complex FC.CFloat) -> IO ())) +hs_bindgen_e2f3985767c79559 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e2f3985767c79559_base {-# NOINLINE args_complex_float_ptr #-} @@ -1774,10 +2097,17 @@ args_complex_float_ptr :: Ptr.FunPtr (A -> (Data.Complex.Complex FC.CFloat) -> I args_complex_float_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e2f3985767c79559 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1da23b0894c2e548" hs_bindgen_1da23b0894c2e548_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Data.Complex.Complex FC.CDouble) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_args_complex_double_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1da23b0894c2e548" hs_bindgen_1da23b0894c2e548 :: +hs_bindgen_1da23b0894c2e548 :: IO (Ptr.FunPtr (A -> (Data.Complex.Complex FC.CDouble) -> IO ())) +hs_bindgen_1da23b0894c2e548 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1da23b0894c2e548_base {-# NOINLINE args_complex_double_ptr #-} @@ -1791,10 +2121,17 @@ args_complex_double_ptr :: Ptr.FunPtr (A -> (Data.Complex.Complex FC.CDouble) -> args_complex_double_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1da23b0894c2e548 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e3d89b51410d7614" hs_bindgen_e3d89b51410d7614_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Data.Complex.Complex FC.CFloat)))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_complex_float_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e3d89b51410d7614" hs_bindgen_e3d89b51410d7614 :: +hs_bindgen_e3d89b51410d7614 :: IO (Ptr.FunPtr (A -> IO (Data.Complex.Complex FC.CFloat))) +hs_bindgen_e3d89b51410d7614 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e3d89b51410d7614_base {-# NOINLINE ret_complex_float_ptr #-} @@ -1808,10 +2145,17 @@ ret_complex_float_ptr :: Ptr.FunPtr (A -> IO (Data.Complex.Complex FC.CFloat)) ret_complex_float_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e3d89b51410d7614 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7cc277a18abf87b8" hs_bindgen_7cc277a18abf87b8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Data.Complex.Complex FC.CDouble)))) + {-| __unique:__ @test_macrosreparse_Example_get_ret_complex_double_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7cc277a18abf87b8" hs_bindgen_7cc277a18abf87b8 :: +hs_bindgen_7cc277a18abf87b8 :: IO (Ptr.FunPtr (A -> IO (Data.Complex.Complex FC.CDouble))) +hs_bindgen_7cc277a18abf87b8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7cc277a18abf87b8_base {-# NOINLINE ret_complex_double_ptr #-} @@ -1825,10 +2169,17 @@ ret_complex_double_ptr :: Ptr.FunPtr (A -> IO (Data.Complex.Complex FC.CDouble)) ret_complex_double_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7cc277a18abf87b8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_764ddaf3efe7bd53" hs_bindgen_764ddaf3efe7bd53_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CBool -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_bespoke_args1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_764ddaf3efe7bd53" hs_bindgen_764ddaf3efe7bd53 :: +hs_bindgen_764ddaf3efe7bd53 :: IO (Ptr.FunPtr (A -> FC.CBool -> IO ())) +hs_bindgen_764ddaf3efe7bd53 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_764ddaf3efe7bd53_base {-# NOINLINE bespoke_args1_ptr #-} @@ -1842,10 +2193,17 @@ bespoke_args1_ptr :: Ptr.FunPtr (A -> FC.CBool -> IO ()) bespoke_args1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_764ddaf3efe7bd53 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_53ccc1b308cd8384" hs_bindgen_53ccc1b308cd8384_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_bespoke_args2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_53ccc1b308cd8384" hs_bindgen_53ccc1b308cd8384 :: +hs_bindgen_53ccc1b308cd8384 :: IO (Ptr.FunPtr (A -> HsBindgen.Runtime.Prelude.CSize -> IO ())) +hs_bindgen_53ccc1b308cd8384 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_53ccc1b308cd8384_base {-# NOINLINE bespoke_args2_ptr #-} @@ -1859,10 +2217,17 @@ bespoke_args2_ptr :: Ptr.FunPtr (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()) bespoke_args2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_53ccc1b308cd8384 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e61f250910ddc098" hs_bindgen_e61f250910ddc098_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO FC.CBool))) + {-| __unique:__ @test_macrosreparse_Example_get_bespoke_ret1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e61f250910ddc098" hs_bindgen_e61f250910ddc098 :: +hs_bindgen_e61f250910ddc098 :: IO (Ptr.FunPtr (A -> IO FC.CBool)) +hs_bindgen_e61f250910ddc098 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e61f250910ddc098_base {-# NOINLINE bespoke_ret1_ptr #-} @@ -1876,10 +2241,17 @@ bespoke_ret1_ptr :: Ptr.FunPtr (A -> IO FC.CBool) bespoke_ret1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e61f250910ddc098 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b9864dba6e30c078" hs_bindgen_b9864dba6e30c078_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO HsBindgen.Runtime.Prelude.CSize))) + {-| __unique:__ @test_macrosreparse_Example_get_bespoke_ret2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b9864dba6e30c078" hs_bindgen_b9864dba6e30c078 :: +hs_bindgen_b9864dba6e30c078 :: IO (Ptr.FunPtr (A -> IO HsBindgen.Runtime.Prelude.CSize)) +hs_bindgen_b9864dba6e30c078 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b9864dba6e30c078_base {-# NOINLINE bespoke_ret2_ptr #-} @@ -1893,10 +2265,17 @@ bespoke_ret2_ptr :: Ptr.FunPtr (A -> IO HsBindgen.Runtime.Prelude.CSize) bespoke_ret2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_b9864dba6e30c078 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bb7f94a203c14e76" hs_bindgen_bb7f94a203c14e76_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray A) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_arr_args1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bb7f94a203c14e76" hs_bindgen_bb7f94a203c14e76 :: +hs_bindgen_bb7f94a203c14e76 :: IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray A) -> IO ())) +hs_bindgen_bb7f94a203c14e76 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bb7f94a203c14e76_base {-# NOINLINE arr_args1_ptr #-} @@ -1912,10 +2291,17 @@ arr_args1_ptr :: Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray arr_args1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bb7f94a203c14e76 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ca2476976e4721ef" hs_bindgen_ca2476976e4721ef_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray (Ptr.Ptr A)) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_arr_args2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ca2476976e4721ef" hs_bindgen_ca2476976e4721ef :: +hs_bindgen_ca2476976e4721ef :: IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray (Ptr.Ptr A)) -> IO ())) +hs_bindgen_ca2476976e4721ef = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ca2476976e4721ef_base {-# NOINLINE arr_args2_ptr #-} @@ -1929,10 +2315,17 @@ arr_args2_ptr :: Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray arr_args2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_ca2476976e4721ef +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3298ac669c00b1cd" hs_bindgen_3298ac669c00b1cd_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 5) A) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_arr_args3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3298ac669c00b1cd" hs_bindgen_3298ac669c00b1cd :: +hs_bindgen_3298ac669c00b1cd :: IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 5) A) -> IO ())) +hs_bindgen_3298ac669c00b1cd = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3298ac669c00b1cd_base {-# NOINLINE arr_args3_ptr #-} @@ -1946,10 +2339,17 @@ arr_args3_ptr :: Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 5) arr_args3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3298ac669c00b1cd +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_329a5d4b44b11e6e" hs_bindgen_329a5d4b44b11e6e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 5) (Ptr.Ptr A)) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_arr_args4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_329a5d4b44b11e6e" hs_bindgen_329a5d4b44b11e6e :: +hs_bindgen_329a5d4b44b11e6e :: IO (Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 5) (Ptr.Ptr A)) -> IO ())) +hs_bindgen_329a5d4b44b11e6e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_329a5d4b44b11e6e_base {-# NOINLINE arr_args4_ptr #-} @@ -1963,10 +2363,17 @@ arr_args4_ptr :: Ptr.FunPtr (((HsBindgen.Runtime.ConstantArray.ConstantArray 5) arr_args4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_329a5d4b44b11e6e +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dac9e3bdccb6a4eb" hs_bindgen_dac9e3bdccb6a4eb_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.FunPtr (IO ())) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_args1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_dac9e3bdccb6a4eb" hs_bindgen_dac9e3bdccb6a4eb :: +hs_bindgen_dac9e3bdccb6a4eb :: IO (Ptr.FunPtr (A -> (Ptr.FunPtr (IO ())) -> IO ())) +hs_bindgen_dac9e3bdccb6a4eb = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_dac9e3bdccb6a4eb_base {-# NOINLINE funptr_args1_ptr #-} @@ -1982,10 +2389,17 @@ funptr_args1_ptr :: Ptr.FunPtr (A -> (Ptr.FunPtr (IO ())) -> IO ()) funptr_args1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_dac9e3bdccb6a4eb +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_83d7f85727e54da4" hs_bindgen_83d7f85727e54da4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_args2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_83d7f85727e54da4" hs_bindgen_83d7f85727e54da4 :: +hs_bindgen_83d7f85727e54da4 :: IO (Ptr.FunPtr (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ())) +hs_bindgen_83d7f85727e54da4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_83d7f85727e54da4_base {-# NOINLINE funptr_args2_ptr #-} @@ -1999,10 +2413,17 @@ funptr_args2_ptr :: Ptr.FunPtr (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ()) funptr_args2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_83d7f85727e54da4 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_107e06f31f9dd017" hs_bindgen_107e06f31f9dd017_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.FunPtr (FC.CInt -> IO ())) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_args3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_107e06f31f9dd017" hs_bindgen_107e06f31f9dd017 :: +hs_bindgen_107e06f31f9dd017 :: IO (Ptr.FunPtr (A -> (Ptr.FunPtr (FC.CInt -> IO ())) -> IO ())) +hs_bindgen_107e06f31f9dd017 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_107e06f31f9dd017_base {-# NOINLINE funptr_args3_ptr #-} @@ -2016,10 +2437,17 @@ funptr_args3_ptr :: Ptr.FunPtr (A -> (Ptr.FunPtr (FC.CInt -> IO ())) -> IO ()) funptr_args3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_107e06f31f9dd017 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_51a7f0cfbd57eaf7" hs_bindgen_51a7f0cfbd57eaf7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar)) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_args4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_51a7f0cfbd57eaf7" hs_bindgen_51a7f0cfbd57eaf7 :: +hs_bindgen_51a7f0cfbd57eaf7 :: IO (Ptr.FunPtr (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar)) -> IO ())) +hs_bindgen_51a7f0cfbd57eaf7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_51a7f0cfbd57eaf7_base {-# NOINLINE funptr_args4_ptr #-} @@ -2033,10 +2461,17 @@ funptr_args4_ptr :: Ptr.FunPtr (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC funptr_args4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_51a7f0cfbd57eaf7 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4a86c3a3b98a00d9" hs_bindgen_4a86c3a3b98a00d9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_args5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4a86c3a3b98a00d9" hs_bindgen_4a86c3a3b98a00d9 :: +hs_bindgen_4a86c3a3b98a00d9 :: IO (Ptr.FunPtr (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) -> IO ())) +hs_bindgen_4a86c3a3b98a00d9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4a86c3a3b98a00d9_base {-# NOINLINE funptr_args5_ptr #-} @@ -2050,10 +2485,17 @@ funptr_args5_ptr :: Ptr.FunPtr (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (P funptr_args5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4a86c3a3b98a00d9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1b13b480c009cf44" hs_bindgen_1b13b480c009cf44_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_comments1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1b13b480c009cf44" hs_bindgen_1b13b480c009cf44 :: +hs_bindgen_1b13b480c009cf44 :: IO (Ptr.FunPtr (A -> IO ())) +hs_bindgen_1b13b480c009cf44 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1b13b480c009cf44_base {-# NOINLINE comments1_ptr #-} @@ -2071,10 +2513,17 @@ comments1_ptr :: Ptr.FunPtr (A -> IO ()) comments1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1b13b480c009cf44 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_410cb526b4cee637" hs_bindgen_410cb526b4cee637_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CChar -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_prim_before1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_410cb526b4cee637" hs_bindgen_410cb526b4cee637 :: +hs_bindgen_410cb526b4cee637 :: IO (Ptr.FunPtr (A -> FC.CChar -> IO ())) +hs_bindgen_410cb526b4cee637 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_410cb526b4cee637_base {-# NOINLINE const_prim_before1_ptr #-} @@ -2092,10 +2541,17 @@ const_prim_before1_ptr :: Ptr.FunPtr (A -> FC.CChar -> IO ()) const_prim_before1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_410cb526b4cee637 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3b1e7a350d422127" hs_bindgen_3b1e7a350d422127_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CSChar -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_prim_before2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3b1e7a350d422127" hs_bindgen_3b1e7a350d422127 :: +hs_bindgen_3b1e7a350d422127 :: IO (Ptr.FunPtr (A -> FC.CSChar -> IO ())) +hs_bindgen_3b1e7a350d422127 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3b1e7a350d422127_base {-# NOINLINE const_prim_before2_ptr #-} @@ -2109,10 +2565,17 @@ const_prim_before2_ptr :: Ptr.FunPtr (A -> FC.CSChar -> IO ()) const_prim_before2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3b1e7a350d422127 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8aab98c0f956e496" hs_bindgen_8aab98c0f956e496_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CUChar -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_prim_before3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8aab98c0f956e496" hs_bindgen_8aab98c0f956e496 :: +hs_bindgen_8aab98c0f956e496 :: IO (Ptr.FunPtr (A -> FC.CUChar -> IO ())) +hs_bindgen_8aab98c0f956e496 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8aab98c0f956e496_base {-# NOINLINE const_prim_before3_ptr #-} @@ -2126,10 +2589,17 @@ const_prim_before3_ptr :: Ptr.FunPtr (A -> FC.CUChar -> IO ()) const_prim_before3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8aab98c0f956e496 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_aeee0dd2b067cf07" hs_bindgen_aeee0dd2b067cf07_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CChar -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_prim_after1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_aeee0dd2b067cf07" hs_bindgen_aeee0dd2b067cf07 :: +hs_bindgen_aeee0dd2b067cf07 :: IO (Ptr.FunPtr (A -> FC.CChar -> IO ())) +hs_bindgen_aeee0dd2b067cf07 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_aeee0dd2b067cf07_base {-# NOINLINE const_prim_after1_ptr #-} @@ -2143,10 +2613,17 @@ const_prim_after1_ptr :: Ptr.FunPtr (A -> FC.CChar -> IO ()) const_prim_after1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_aeee0dd2b067cf07 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ca5ab7dc437ce5d1" hs_bindgen_ca5ab7dc437ce5d1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CSChar -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_prim_after2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ca5ab7dc437ce5d1" hs_bindgen_ca5ab7dc437ce5d1 :: +hs_bindgen_ca5ab7dc437ce5d1 :: IO (Ptr.FunPtr (A -> FC.CSChar -> IO ())) +hs_bindgen_ca5ab7dc437ce5d1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ca5ab7dc437ce5d1_base {-# NOINLINE const_prim_after2_ptr #-} @@ -2160,10 +2637,17 @@ const_prim_after2_ptr :: Ptr.FunPtr (A -> FC.CSChar -> IO ()) const_prim_after2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_ca5ab7dc437ce5d1 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a6ae03f6051fcb2a" hs_bindgen_a6ae03f6051fcb2a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CUChar -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_prim_after3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a6ae03f6051fcb2a" hs_bindgen_a6ae03f6051fcb2a :: +hs_bindgen_a6ae03f6051fcb2a :: IO (Ptr.FunPtr (A -> FC.CUChar -> IO ())) +hs_bindgen_a6ae03f6051fcb2a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a6ae03f6051fcb2a_base {-# NOINLINE const_prim_after3_ptr #-} @@ -2177,10 +2661,17 @@ const_prim_after3_ptr :: Ptr.FunPtr (A -> FC.CUChar -> IO ()) const_prim_after3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a6ae03f6051fcb2a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_aea82678489f8007" hs_bindgen_aea82678489f8007_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CFloat -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_aea82678489f8007" hs_bindgen_aea82678489f8007 :: +hs_bindgen_aea82678489f8007 :: IO (Ptr.FunPtr (A -> FC.CFloat -> IO ())) +hs_bindgen_aea82678489f8007 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_aea82678489f8007_base {-# NOINLINE const_withoutSign_before1_ptr #-} @@ -2194,10 +2685,17 @@ const_withoutSign_before1_ptr :: Ptr.FunPtr (A -> FC.CFloat -> IO ()) const_withoutSign_before1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_aea82678489f8007 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_79b5f5987a75db98" hs_bindgen_79b5f5987a75db98_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CDouble -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_79b5f5987a75db98" hs_bindgen_79b5f5987a75db98 :: +hs_bindgen_79b5f5987a75db98 :: IO (Ptr.FunPtr (A -> FC.CDouble -> IO ())) +hs_bindgen_79b5f5987a75db98 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_79b5f5987a75db98_base {-# NOINLINE const_withoutSign_before2_ptr #-} @@ -2211,10 +2709,17 @@ const_withoutSign_before2_ptr :: Ptr.FunPtr (A -> FC.CDouble -> IO ()) const_withoutSign_before2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_79b5f5987a75db98 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fafbaf6c727e6e6d" hs_bindgen_fafbaf6c727e6e6d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CBool -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_fafbaf6c727e6e6d" hs_bindgen_fafbaf6c727e6e6d :: +hs_bindgen_fafbaf6c727e6e6d :: IO (Ptr.FunPtr (A -> FC.CBool -> IO ())) +hs_bindgen_fafbaf6c727e6e6d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_fafbaf6c727e6e6d_base {-# NOINLINE const_withoutSign_before3_ptr #-} @@ -2228,10 +2733,17 @@ const_withoutSign_before3_ptr :: Ptr.FunPtr (A -> FC.CBool -> IO ()) const_withoutSign_before3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_fafbaf6c727e6e6d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c9342430ac667d8a" hs_bindgen_c9342430ac667d8a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> Some_struct -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c9342430ac667d8a" hs_bindgen_c9342430ac667d8a :: +hs_bindgen_c9342430ac667d8a :: IO (Ptr.FunPtr (A -> Some_struct -> IO ())) +hs_bindgen_c9342430ac667d8a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c9342430ac667d8a_base {-# NOINLINE const_withoutSign_before4_ptr #-} @@ -2245,10 +2757,17 @@ const_withoutSign_before4_ptr :: Ptr.FunPtr (A -> Some_struct -> IO ()) const_withoutSign_before4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c9342430ac667d8a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_25501097b98452bd" hs_bindgen_25501097b98452bd_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> Some_union -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_25501097b98452bd" hs_bindgen_25501097b98452bd :: +hs_bindgen_25501097b98452bd :: IO (Ptr.FunPtr (A -> Some_union -> IO ())) +hs_bindgen_25501097b98452bd = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_25501097b98452bd_base {-# NOINLINE const_withoutSign_before5_ptr #-} @@ -2262,10 +2781,17 @@ const_withoutSign_before5_ptr :: Ptr.FunPtr (A -> Some_union -> IO ()) const_withoutSign_before5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_25501097b98452bd +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4b356af92ea4b405" hs_bindgen_4b356af92ea4b405_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> Some_enum -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before6_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4b356af92ea4b405" hs_bindgen_4b356af92ea4b405 :: +hs_bindgen_4b356af92ea4b405 :: IO (Ptr.FunPtr (A -> Some_enum -> IO ())) +hs_bindgen_4b356af92ea4b405 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4b356af92ea4b405_base {-# NOINLINE const_withoutSign_before6_ptr #-} @@ -2279,10 +2805,17 @@ const_withoutSign_before6_ptr :: Ptr.FunPtr (A -> Some_enum -> IO ()) const_withoutSign_before6_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4b356af92ea4b405 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_90b574ff639ebbd5" hs_bindgen_90b574ff639ebbd5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CBool -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before7_ptr@ -} -foreign import ccall unsafe "hs_bindgen_90b574ff639ebbd5" hs_bindgen_90b574ff639ebbd5 :: +hs_bindgen_90b574ff639ebbd5 :: IO (Ptr.FunPtr (A -> FC.CBool -> IO ())) +hs_bindgen_90b574ff639ebbd5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_90b574ff639ebbd5_base {-# NOINLINE const_withoutSign_before7_ptr #-} @@ -2296,10 +2829,17 @@ const_withoutSign_before7_ptr :: Ptr.FunPtr (A -> FC.CBool -> IO ()) const_withoutSign_before7_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_90b574ff639ebbd5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cbb78eb3b806c344" hs_bindgen_cbb78eb3b806c344_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before8_ptr@ -} -foreign import ccall unsafe "hs_bindgen_cbb78eb3b806c344" hs_bindgen_cbb78eb3b806c344 :: +hs_bindgen_cbb78eb3b806c344 :: IO (Ptr.FunPtr (A -> HsBindgen.Runtime.Prelude.CSize -> IO ())) +hs_bindgen_cbb78eb3b806c344 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_cbb78eb3b806c344_base {-# NOINLINE const_withoutSign_before8_ptr #-} @@ -2313,10 +2853,17 @@ const_withoutSign_before8_ptr :: Ptr.FunPtr (A -> HsBindgen.Runtime.Prelude.CSiz const_withoutSign_before8_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_cbb78eb3b806c344 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f4083b3232462a5b" hs_bindgen_f4083b3232462a5b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CFloat -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f4083b3232462a5b" hs_bindgen_f4083b3232462a5b :: +hs_bindgen_f4083b3232462a5b :: IO (Ptr.FunPtr (A -> FC.CFloat -> IO ())) +hs_bindgen_f4083b3232462a5b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f4083b3232462a5b_base {-# NOINLINE const_withoutSign_after1_ptr #-} @@ -2330,10 +2877,17 @@ const_withoutSign_after1_ptr :: Ptr.FunPtr (A -> FC.CFloat -> IO ()) const_withoutSign_after1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f4083b3232462a5b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cf16d660d9d916df" hs_bindgen_cf16d660d9d916df_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CDouble -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_cf16d660d9d916df" hs_bindgen_cf16d660d9d916df :: +hs_bindgen_cf16d660d9d916df :: IO (Ptr.FunPtr (A -> FC.CDouble -> IO ())) +hs_bindgen_cf16d660d9d916df = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_cf16d660d9d916df_base {-# NOINLINE const_withoutSign_after2_ptr #-} @@ -2347,10 +2901,17 @@ const_withoutSign_after2_ptr :: Ptr.FunPtr (A -> FC.CDouble -> IO ()) const_withoutSign_after2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_cf16d660d9d916df +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_41a40ed22011f536" hs_bindgen_41a40ed22011f536_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CBool -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_41a40ed22011f536" hs_bindgen_41a40ed22011f536 :: +hs_bindgen_41a40ed22011f536 :: IO (Ptr.FunPtr (A -> FC.CBool -> IO ())) +hs_bindgen_41a40ed22011f536 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_41a40ed22011f536_base {-# NOINLINE const_withoutSign_after3_ptr #-} @@ -2364,10 +2925,17 @@ const_withoutSign_after3_ptr :: Ptr.FunPtr (A -> FC.CBool -> IO ()) const_withoutSign_after3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_41a40ed22011f536 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4bc0069f381d29c9" hs_bindgen_4bc0069f381d29c9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> Some_struct -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4bc0069f381d29c9" hs_bindgen_4bc0069f381d29c9 :: +hs_bindgen_4bc0069f381d29c9 :: IO (Ptr.FunPtr (A -> Some_struct -> IO ())) +hs_bindgen_4bc0069f381d29c9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4bc0069f381d29c9_base {-# NOINLINE const_withoutSign_after4_ptr #-} @@ -2381,10 +2949,17 @@ const_withoutSign_after4_ptr :: Ptr.FunPtr (A -> Some_struct -> IO ()) const_withoutSign_after4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4bc0069f381d29c9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e064a509e456b021" hs_bindgen_e064a509e456b021_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> Some_union -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e064a509e456b021" hs_bindgen_e064a509e456b021 :: +hs_bindgen_e064a509e456b021 :: IO (Ptr.FunPtr (A -> Some_union -> IO ())) +hs_bindgen_e064a509e456b021 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e064a509e456b021_base {-# NOINLINE const_withoutSign_after5_ptr #-} @@ -2398,10 +2973,17 @@ const_withoutSign_after5_ptr :: Ptr.FunPtr (A -> Some_union -> IO ()) const_withoutSign_after5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e064a509e456b021 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b89597d47b21f2fd" hs_bindgen_b89597d47b21f2fd_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> Some_enum -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after6_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b89597d47b21f2fd" hs_bindgen_b89597d47b21f2fd :: +hs_bindgen_b89597d47b21f2fd :: IO (Ptr.FunPtr (A -> Some_enum -> IO ())) +hs_bindgen_b89597d47b21f2fd = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b89597d47b21f2fd_base {-# NOINLINE const_withoutSign_after6_ptr #-} @@ -2415,10 +2997,17 @@ const_withoutSign_after6_ptr :: Ptr.FunPtr (A -> Some_enum -> IO ()) const_withoutSign_after6_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_b89597d47b21f2fd +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_127b2fb737af1d7a" hs_bindgen_127b2fb737af1d7a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> FC.CBool -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after7_ptr@ -} -foreign import ccall unsafe "hs_bindgen_127b2fb737af1d7a" hs_bindgen_127b2fb737af1d7a :: +hs_bindgen_127b2fb737af1d7a :: IO (Ptr.FunPtr (A -> FC.CBool -> IO ())) +hs_bindgen_127b2fb737af1d7a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_127b2fb737af1d7a_base {-# NOINLINE const_withoutSign_after7_ptr #-} @@ -2432,10 +3021,17 @@ const_withoutSign_after7_ptr :: Ptr.FunPtr (A -> FC.CBool -> IO ()) const_withoutSign_after7_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_127b2fb737af1d7a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_05c7bd4fa507a58c" hs_bindgen_05c7bd4fa507a58c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after8_ptr@ -} -foreign import ccall unsafe "hs_bindgen_05c7bd4fa507a58c" hs_bindgen_05c7bd4fa507a58c :: +hs_bindgen_05c7bd4fa507a58c :: IO (Ptr.FunPtr (A -> HsBindgen.Runtime.Prelude.CSize -> IO ())) +hs_bindgen_05c7bd4fa507a58c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_05c7bd4fa507a58c_base {-# NOINLINE const_withoutSign_after8_ptr #-} @@ -2449,10 +3045,17 @@ const_withoutSign_after8_ptr :: Ptr.FunPtr (A -> HsBindgen.Runtime.Prelude.CSize const_withoutSign_after8_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_05c7bd4fa507a58c +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dfa6f2ec505f391a" hs_bindgen_dfa6f2ec505f391a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_dfa6f2ec505f391a" hs_bindgen_dfa6f2ec505f391a :: +hs_bindgen_dfa6f2ec505f391a :: IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ())) +hs_bindgen_dfa6f2ec505f391a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_dfa6f2ec505f391a_base {-# NOINLINE const_pointers_args1_ptr #-} @@ -2466,10 +3069,17 @@ const_pointers_args1_ptr :: Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()) const_pointers_args1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_dfa6f2ec505f391a +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2f758756849ca2b5" hs_bindgen_2f758756849ca2b5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2f758756849ca2b5" hs_bindgen_2f758756849ca2b5 :: +hs_bindgen_2f758756849ca2b5 :: IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ())) +hs_bindgen_2f758756849ca2b5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2f758756849ca2b5_base {-# NOINLINE const_pointers_args2_ptr #-} @@ -2483,10 +3093,17 @@ const_pointers_args2_ptr :: Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()) const_pointers_args2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2f758756849ca2b5 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1f9d3190b4433852" hs_bindgen_1f9d3190b4433852_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1f9d3190b4433852" hs_bindgen_1f9d3190b4433852 :: +hs_bindgen_1f9d3190b4433852 :: IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ())) +hs_bindgen_1f9d3190b4433852 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1f9d3190b4433852_base {-# NOINLINE const_pointers_args3_ptr #-} @@ -2500,10 +3117,17 @@ const_pointers_args3_ptr :: Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()) const_pointers_args3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1f9d3190b4433852 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1579ab85f0fa217b" hs_bindgen_1579ab85f0fa217b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1579ab85f0fa217b" hs_bindgen_1579ab85f0fa217b :: +hs_bindgen_1579ab85f0fa217b :: IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ())) +hs_bindgen_1579ab85f0fa217b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1579ab85f0fa217b_base {-# NOINLINE const_pointers_args4_ptr #-} @@ -2517,10 +3141,17 @@ const_pointers_args4_ptr :: Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()) const_pointers_args4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1579ab85f0fa217b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b4770dc5310bc558" hs_bindgen_b4770dc5310bc558_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b4770dc5310bc558" hs_bindgen_b4770dc5310bc558 :: +hs_bindgen_b4770dc5310bc558 :: IO (Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ())) +hs_bindgen_b4770dc5310bc558 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b4770dc5310bc558_base {-# NOINLINE const_pointers_args5_ptr #-} @@ -2534,10 +3165,17 @@ const_pointers_args5_ptr :: Ptr.FunPtr (A -> (Ptr.Ptr FC.CInt) -> IO ()) const_pointers_args5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_b4770dc5310bc558 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8422fbf55ee37cbb" hs_bindgen_8422fbf55ee37cbb_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8422fbf55ee37cbb" hs_bindgen_8422fbf55ee37cbb :: +hs_bindgen_8422fbf55ee37cbb :: IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt))) +hs_bindgen_8422fbf55ee37cbb = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8422fbf55ee37cbb_base {-# NOINLINE const_pointers_ret1_ptr #-} @@ -2551,10 +3189,17 @@ const_pointers_ret1_ptr :: Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)) const_pointers_ret1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8422fbf55ee37cbb +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7d62d267cb012ebf" hs_bindgen_7d62d267cb012ebf_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7d62d267cb012ebf" hs_bindgen_7d62d267cb012ebf :: +hs_bindgen_7d62d267cb012ebf :: IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt))) +hs_bindgen_7d62d267cb012ebf = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7d62d267cb012ebf_base {-# NOINLINE const_pointers_ret2_ptr #-} @@ -2568,10 +3213,17 @@ const_pointers_ret2_ptr :: Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)) const_pointers_ret2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_7d62d267cb012ebf +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d56e13b56b7e1cf7" hs_bindgen_d56e13b56b7e1cf7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d56e13b56b7e1cf7" hs_bindgen_d56e13b56b7e1cf7 :: +hs_bindgen_d56e13b56b7e1cf7 :: IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt))) +hs_bindgen_d56e13b56b7e1cf7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d56e13b56b7e1cf7_base {-# NOINLINE const_pointers_ret3_ptr #-} @@ -2585,10 +3237,17 @@ const_pointers_ret3_ptr :: Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)) const_pointers_ret3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d56e13b56b7e1cf7 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bedc6b38f49c61ea" hs_bindgen_bedc6b38f49c61ea_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bedc6b38f49c61ea" hs_bindgen_bedc6b38f49c61ea :: +hs_bindgen_bedc6b38f49c61ea :: IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt))) +hs_bindgen_bedc6b38f49c61ea = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bedc6b38f49c61ea_base {-# NOINLINE const_pointers_ret4_ptr #-} @@ -2602,10 +3261,17 @@ const_pointers_ret4_ptr :: Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)) const_pointers_ret4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bedc6b38f49c61ea +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8d027f9f58006eb9" hs_bindgen_8d027f9f58006eb9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)))) + {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8d027f9f58006eb9" hs_bindgen_8d027f9f58006eb9 :: +hs_bindgen_8d027f9f58006eb9 :: IO (Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt))) +hs_bindgen_8d027f9f58006eb9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8d027f9f58006eb9_base {-# NOINLINE const_pointers_ret5_ptr #-} @@ -2619,10 +3285,17 @@ const_pointers_ret5_ptr :: Ptr.FunPtr (A -> IO (Ptr.Ptr FC.CInt)) const_pointers_ret5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8d027f9f58006eb9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_882567df89856ac9" hs_bindgen_882567df89856ac9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray A) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_array_elem1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_882567df89856ac9" hs_bindgen_882567df89856ac9 :: +hs_bindgen_882567df89856ac9 :: IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray A) -> IO ())) +hs_bindgen_882567df89856ac9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_882567df89856ac9_base {-# NOINLINE const_array_elem1_ptr #-} @@ -2636,10 +3309,17 @@ const_array_elem1_ptr :: Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.Incomple const_array_elem1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_882567df89856ac9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_70e4ab7a50eb5360" hs_bindgen_70e4ab7a50eb5360_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray (Ptr.Ptr A)) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_array_elem2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_70e4ab7a50eb5360" hs_bindgen_70e4ab7a50eb5360 :: +hs_bindgen_70e4ab7a50eb5360 :: IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray (Ptr.Ptr A)) -> IO ())) +hs_bindgen_70e4ab7a50eb5360 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_70e4ab7a50eb5360_base {-# NOINLINE const_array_elem2_ptr #-} @@ -2653,10 +3333,17 @@ const_array_elem2_ptr :: Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.Incomple const_array_elem2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_70e4ab7a50eb5360 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_14a733fd770b7242" hs_bindgen_14a733fd770b7242_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray (Ptr.Ptr A)) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_const_array_elem3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_14a733fd770b7242" hs_bindgen_14a733fd770b7242 :: +hs_bindgen_14a733fd770b7242 :: IO (Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.IncompleteArray (Ptr.Ptr A)) -> IO ())) +hs_bindgen_14a733fd770b7242 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_14a733fd770b7242_base {-# NOINLINE const_array_elem3_ptr #-} @@ -2670,10 +3357,17 @@ const_array_elem3_ptr :: Ptr.FunPtr ((HsBindgen.Runtime.IncompleteArray.Incomple const_array_elem3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_14a733fd770b7242 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8e462fca4a002e73" hs_bindgen_8e462fca4a002e73_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO A))) + {-| __unique:__ @test_macrosreparse_Example_get_noParams1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8e462fca4a002e73" hs_bindgen_8e462fca4a002e73 :: +hs_bindgen_8e462fca4a002e73 :: IO (Ptr.FunPtr (IO A)) +hs_bindgen_8e462fca4a002e73 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8e462fca4a002e73_base {-# NOINLINE noParams1_ptr #-} @@ -2689,10 +3383,17 @@ noParams1_ptr :: Ptr.FunPtr (IO A) noParams1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8e462fca4a002e73 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_42667590c95d450e" hs_bindgen_42667590c95d450e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO A))) + {-| __unique:__ @test_macrosreparse_Example_get_noParams2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_42667590c95d450e" hs_bindgen_42667590c95d450e :: +hs_bindgen_42667590c95d450e :: IO (Ptr.FunPtr (IO A)) +hs_bindgen_42667590c95d450e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_42667590c95d450e_base {-# NOINLINE noParams2_ptr #-} @@ -2706,10 +3407,17 @@ noParams2_ptr :: Ptr.FunPtr (IO A) noParams2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_42667590c95d450e +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_23777cd9313c8c63" hs_bindgen_23777cd9313c8c63_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ()))) + {-| __unique:__ @test_macrosreparse_Example_get_noParams3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_23777cd9313c8c63" hs_bindgen_23777cd9313c8c63 :: +hs_bindgen_23777cd9313c8c63 :: IO (Ptr.FunPtr (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ())) +hs_bindgen_23777cd9313c8c63 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_23777cd9313c8c63_base {-# NOINLINE noParams3_ptr #-} @@ -2723,10 +3431,17 @@ noParams3_ptr :: Ptr.FunPtr (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ()) noParams3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_23777cd9313c8c63 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a8f974caf74669f9" hs_bindgen_a8f974caf74669f9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (IO ()))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a8f974caf74669f9" hs_bindgen_a8f974caf74669f9 :: +hs_bindgen_a8f974caf74669f9 :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (IO ())))) +hs_bindgen_a8f974caf74669f9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a8f974caf74669f9_base {-# NOINLINE funptr_ret1_ptr #-} @@ -2740,10 +3455,17 @@ funptr_ret1_ptr :: Ptr.FunPtr (A -> IO (Ptr.FunPtr (IO ()))) funptr_ret1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a8f974caf74669f9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f13795ebabb26526" hs_bindgen_f13795ebabb26526_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (IO FC.CInt))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f13795ebabb26526" hs_bindgen_f13795ebabb26526 :: +hs_bindgen_f13795ebabb26526 :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (IO FC.CInt)))) +hs_bindgen_f13795ebabb26526 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f13795ebabb26526_base {-# NOINLINE funptr_ret2_ptr #-} @@ -2757,10 +3479,17 @@ funptr_ret2_ptr :: Ptr.FunPtr (A -> IO (Ptr.FunPtr (IO FC.CInt))) funptr_ret2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f13795ebabb26526 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2515837794143ac1" hs_bindgen_2515837794143ac1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> IO ()))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_2515837794143ac1" hs_bindgen_2515837794143ac1 :: +hs_bindgen_2515837794143ac1 :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> IO ())))) +hs_bindgen_2515837794143ac1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_2515837794143ac1_base {-# NOINLINE funptr_ret3_ptr #-} @@ -2774,10 +3503,17 @@ funptr_ret3_ptr :: Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> IO ()))) funptr_ret3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_2515837794143ac1 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f01ceaf447c3de04" hs_bindgen_f01ceaf447c3de04_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret4_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f01ceaf447c3de04" hs_bindgen_f01ceaf447c3de04 :: +hs_bindgen_f01ceaf447c3de04 :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar)))) +hs_bindgen_f01ceaf447c3de04 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f01ceaf447c3de04_base {-# NOINLINE funptr_ret4_ptr #-} @@ -2791,10 +3527,17 @@ funptr_ret4_ptr :: Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO funptr_ret4_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f01ceaf447c3de04 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3cb2c77a66e6f46f" hs_bindgen_3cb2c77a66e6f46f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret5_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3cb2c77a66e6f46f" hs_bindgen_3cb2c77a66e6f46f :: +hs_bindgen_3cb2c77a66e6f46f :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))))) +hs_bindgen_3cb2c77a66e6f46f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3cb2c77a66e6f46f_base {-# NOINLINE funptr_ret5_ptr #-} @@ -2808,10 +3551,17 @@ funptr_ret5_ptr :: Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO funptr_ret5_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3cb2c77a66e6f46f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3a28c985fce638f9" hs_bindgen_3a28c985fce638f9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret6_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3a28c985fce638f9" hs_bindgen_3a28c985fce638f9 :: +hs_bindgen_3a28c985fce638f9 :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))))) +hs_bindgen_3a28c985fce638f9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3a28c985fce638f9_base {-# NOINLINE funptr_ret6_ptr #-} @@ -2825,10 +3575,17 @@ funptr_ret6_ptr :: Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO funptr_ret6_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_3a28c985fce638f9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e155fd240d710be2" hs_bindgen_e155fd240d710be2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret7_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e155fd240d710be2" hs_bindgen_e155fd240d710be2 :: +hs_bindgen_e155fd240d710be2 :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))))) +hs_bindgen_e155fd240d710be2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e155fd240d710be2_base {-# NOINLINE funptr_ret7_ptr #-} @@ -2842,10 +3599,17 @@ funptr_ret7_ptr :: Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO funptr_ret7_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e155fd240d710be2 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_61261c2147d69f98" hs_bindgen_61261c2147d69f98_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret8_ptr@ -} -foreign import ccall unsafe "hs_bindgen_61261c2147d69f98" hs_bindgen_61261c2147d69f98 :: +hs_bindgen_61261c2147d69f98 :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))))) +hs_bindgen_61261c2147d69f98 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_61261c2147d69f98_base {-# NOINLINE funptr_ret8_ptr #-} @@ -2859,10 +3623,17 @@ funptr_ret8_ptr :: Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO funptr_ret8_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_61261c2147d69f98 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e3c71dfaf82486c8" hs_bindgen_e3c71dfaf82486c8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret9_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e3c71dfaf82486c8" hs_bindgen_e3c71dfaf82486c8 :: +hs_bindgen_e3c71dfaf82486c8 :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))))) +hs_bindgen_e3c71dfaf82486c8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e3c71dfaf82486c8_base {-# NOINLINE funptr_ret9_ptr #-} @@ -2876,10 +3647,17 @@ funptr_ret9_ptr :: Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO funptr_ret9_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e3c71dfaf82486c8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6a47446b9176f0bf" hs_bindgen_6a47446b9176f0bf_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))))) + {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret10_ptr@ -} -foreign import ccall unsafe "hs_bindgen_6a47446b9176f0bf" hs_bindgen_6a47446b9176f0bf :: +hs_bindgen_6a47446b9176f0bf :: IO (Ptr.FunPtr (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))))) +hs_bindgen_6a47446b9176f0bf = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_6a47446b9176f0bf_base {-# NOINLINE funptr_ret10_ptr #-} diff --git a/hs-bindgen/fixtures/macros/reparse/Example/Safe.hs b/hs-bindgen/fixtures/macros/reparse/Example/Safe.hs index 989a1116e..68813ef8b 100644 --- a/hs-bindgen/fixtures/macros/reparse/Example/Safe.hs +++ b/hs-bindgen/fixtures/macros/reparse/Example/Safe.hs @@ -10,6 +10,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.CAPI +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) @@ -771,6 +772,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f15610128336b06a" args_char1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CChar -> IO ()) + {-| Function declarations __C declaration:__ @args_char1@ @@ -781,7 +787,7 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Safe_args_char1@ -} -foreign import ccall safe "hs_bindgen_f15610128336b06a" args_char1 :: +args_char1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -789,6 +795,13 @@ foreign import ccall safe "hs_bindgen_f15610128336b06a" args_char1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_char1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_char1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_087f45ca0a284a03" args_char2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CSChar -> IO ()) {-| __C declaration:__ @args_char2@ @@ -798,7 +811,7 @@ foreign import ccall safe "hs_bindgen_f15610128336b06a" args_char1 :: __unique:__ @test_macrosreparse_Example_Safe_args_char2@ -} -foreign import ccall safe "hs_bindgen_087f45ca0a284a03" args_char2 :: +args_char2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -806,6 +819,13 @@ foreign import ccall safe "hs_bindgen_087f45ca0a284a03" args_char2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_char2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_char2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f6cb5c5a728c2404" args_char3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUChar -> IO ()) {-| __C declaration:__ @args_char3@ @@ -815,7 +835,7 @@ foreign import ccall safe "hs_bindgen_087f45ca0a284a03" args_char2 :: __unique:__ @test_macrosreparse_Example_Safe_args_char3@ -} -foreign import ccall safe "hs_bindgen_f6cb5c5a728c2404" args_char3 :: +args_char3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -823,6 +843,13 @@ foreign import ccall safe "hs_bindgen_f6cb5c5a728c2404" args_char3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_char3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_char3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d485767e0caa1f7c" args_short1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CShort -> IO ()) {-| __C declaration:__ @args_short1@ @@ -832,7 +859,7 @@ foreign import ccall safe "hs_bindgen_f6cb5c5a728c2404" args_char3 :: __unique:__ @test_macrosreparse_Example_Safe_args_short1@ -} -foreign import ccall safe "hs_bindgen_d485767e0caa1f7c" args_short1 :: +args_short1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -840,6 +867,13 @@ foreign import ccall safe "hs_bindgen_d485767e0caa1f7c" args_short1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_short1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_short1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_833c96c437533e02" args_short2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CShort -> IO ()) {-| __C declaration:__ @args_short2@ @@ -849,7 +883,7 @@ foreign import ccall safe "hs_bindgen_d485767e0caa1f7c" args_short1 :: __unique:__ @test_macrosreparse_Example_Safe_args_short2@ -} -foreign import ccall safe "hs_bindgen_833c96c437533e02" args_short2 :: +args_short2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -857,6 +891,13 @@ foreign import ccall safe "hs_bindgen_833c96c437533e02" args_short2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_short2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_short2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0e1eedc3fcbcea7a" args_short3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUShort -> IO ()) {-| __C declaration:__ @args_short3@ @@ -866,7 +907,7 @@ foreign import ccall safe "hs_bindgen_833c96c437533e02" args_short2 :: __unique:__ @test_macrosreparse_Example_Safe_args_short3@ -} -foreign import ccall safe "hs_bindgen_0e1eedc3fcbcea7a" args_short3 :: +args_short3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -874,6 +915,13 @@ foreign import ccall safe "hs_bindgen_0e1eedc3fcbcea7a" args_short3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_short3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_short3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_906f0ac7dfd36ab8" args_int1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CInt -> IO ()) {-| __C declaration:__ @args_int1@ @@ -883,7 +931,7 @@ foreign import ccall safe "hs_bindgen_0e1eedc3fcbcea7a" args_short3 :: __unique:__ @test_macrosreparse_Example_Safe_args_int1@ -} -foreign import ccall safe "hs_bindgen_906f0ac7dfd36ab8" args_int1 :: +args_int1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -891,6 +939,13 @@ foreign import ccall safe "hs_bindgen_906f0ac7dfd36ab8" args_int1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_int1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_int1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0edbc9b995b2a589" args_int2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CInt -> IO ()) {-| __C declaration:__ @args_int2@ @@ -900,7 +955,7 @@ foreign import ccall safe "hs_bindgen_906f0ac7dfd36ab8" args_int1 :: __unique:__ @test_macrosreparse_Example_Safe_args_int2@ -} -foreign import ccall safe "hs_bindgen_0edbc9b995b2a589" args_int2 :: +args_int2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -908,6 +963,13 @@ foreign import ccall safe "hs_bindgen_0edbc9b995b2a589" args_int2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_int2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_int2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a5c223f58a255115" args_int3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUInt -> IO ()) {-| __C declaration:__ @args_int3@ @@ -917,7 +979,7 @@ foreign import ccall safe "hs_bindgen_0edbc9b995b2a589" args_int2 :: __unique:__ @test_macrosreparse_Example_Safe_args_int3@ -} -foreign import ccall safe "hs_bindgen_a5c223f58a255115" args_int3 :: +args_int3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -925,6 +987,13 @@ foreign import ccall safe "hs_bindgen_a5c223f58a255115" args_int3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_int3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_int3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_41d1229384b9a529" args_long1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CLong -> IO ()) {-| __C declaration:__ @args_long1@ @@ -934,7 +1003,7 @@ foreign import ccall safe "hs_bindgen_a5c223f58a255115" args_int3 :: __unique:__ @test_macrosreparse_Example_Safe_args_long1@ -} -foreign import ccall safe "hs_bindgen_41d1229384b9a529" args_long1 :: +args_long1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -942,6 +1011,13 @@ foreign import ccall safe "hs_bindgen_41d1229384b9a529" args_long1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_long1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_long1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a9a4b09fd3bd83db" args_long2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CLong -> IO ()) {-| __C declaration:__ @args_long2@ @@ -951,7 +1027,7 @@ foreign import ccall safe "hs_bindgen_41d1229384b9a529" args_long1 :: __unique:__ @test_macrosreparse_Example_Safe_args_long2@ -} -foreign import ccall safe "hs_bindgen_a9a4b09fd3bd83db" args_long2 :: +args_long2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -959,6 +1035,13 @@ foreign import ccall safe "hs_bindgen_a9a4b09fd3bd83db" args_long2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_long2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_long2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_31dc2e680b3f3eff" args_long3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CULong -> IO ()) {-| __C declaration:__ @args_long3@ @@ -968,7 +1051,7 @@ foreign import ccall safe "hs_bindgen_a9a4b09fd3bd83db" args_long2 :: __unique:__ @test_macrosreparse_Example_Safe_args_long3@ -} -foreign import ccall safe "hs_bindgen_31dc2e680b3f3eff" args_long3 :: +args_long3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -976,6 +1059,13 @@ foreign import ccall safe "hs_bindgen_31dc2e680b3f3eff" args_long3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_long3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_long3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3d400757b5cbf4b7" args_float_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CFloat -> IO ()) {-| __C declaration:__ @args_float@ @@ -985,7 +1075,7 @@ foreign import ccall safe "hs_bindgen_31dc2e680b3f3eff" args_long3 :: __unique:__ @test_macrosreparse_Example_Safe_args_float@ -} -foreign import ccall safe "hs_bindgen_3d400757b5cbf4b7" args_float :: +args_float :: A {- ^ __C declaration:__ @arg1@ -} @@ -993,6 +1083,13 @@ foreign import ccall safe "hs_bindgen_3d400757b5cbf4b7" args_float :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_float = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_float_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_70df07e39900487e" args_double_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CDouble -> IO ()) {-| __C declaration:__ @args_double@ @@ -1002,7 +1099,7 @@ foreign import ccall safe "hs_bindgen_3d400757b5cbf4b7" args_float :: __unique:__ @test_macrosreparse_Example_Safe_args_double@ -} -foreign import ccall safe "hs_bindgen_70df07e39900487e" args_double :: +args_double :: A {- ^ __C declaration:__ @arg1@ -} @@ -1010,6 +1107,13 @@ foreign import ccall safe "hs_bindgen_70df07e39900487e" args_double :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_double = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_double_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0b7c534fe683f843" args_bool1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @args_bool1@ @@ -1019,7 +1123,7 @@ foreign import ccall safe "hs_bindgen_70df07e39900487e" args_double :: __unique:__ @test_macrosreparse_Example_Safe_args_bool1@ -} -foreign import ccall safe "hs_bindgen_0b7c534fe683f843" args_bool1 :: +args_bool1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1027,15 +1131,24 @@ foreign import ccall safe "hs_bindgen_0b7c534fe683f843" args_bool1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_bool1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_bool1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b20e084f7b7941b5" args_struct_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_struct) -> IO ()) {-| Pointer-based API for 'args_struct' __unique:__ @test_macrosreparse_Example_Safe_args_struct@ -} -foreign import ccall safe "hs_bindgen_b20e084f7b7941b5" args_struct_wrapper :: +args_struct_wrapper :: A -> Ptr.Ptr Some_struct -> IO () +args_struct_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_struct_wrapper_base {-| __C declaration:__ @args_struct@ @@ -1055,14 +1168,21 @@ args_struct = \x0 -> \x1 -> F.with x1 (\y2 -> args_struct_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_23aff33f33b6bdd1" args_union_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_union) -> IO ()) + {-| Pointer-based API for 'args_union' __unique:__ @test_macrosreparse_Example_Safe_args_union@ -} -foreign import ccall safe "hs_bindgen_23aff33f33b6bdd1" args_union_wrapper :: +args_union_wrapper :: A -> Ptr.Ptr Some_union -> IO () +args_union_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_union_wrapper_base {-| __C declaration:__ @args_union@ @@ -1082,6 +1202,11 @@ args_union = \x0 -> \x1 -> F.with x1 (\y2 -> args_union_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fdd58ae14ce15ed5" args_enum_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> Some_enum -> IO ()) + {-| __C declaration:__ @args_enum@ __defined at:__ @macros\/reparse.h:39:6@ @@ -1090,7 +1215,7 @@ args_union = __unique:__ @test_macrosreparse_Example_Safe_args_enum@ -} -foreign import ccall safe "hs_bindgen_fdd58ae14ce15ed5" args_enum :: +args_enum :: A {- ^ __C declaration:__ @arg1@ -} @@ -1098,6 +1223,13 @@ foreign import ccall safe "hs_bindgen_fdd58ae14ce15ed5" args_enum :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_enum = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_enum_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_42ce2ec4fd2eda72" args_pointer1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @args_pointer1@ @@ -1107,7 +1239,7 @@ foreign import ccall safe "hs_bindgen_fdd58ae14ce15ed5" args_enum :: __unique:__ @test_macrosreparse_Example_Safe_args_pointer1@ -} -foreign import ccall safe "hs_bindgen_42ce2ec4fd2eda72" args_pointer1 :: +args_pointer1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1115,6 +1247,13 @@ foreign import ccall safe "hs_bindgen_42ce2ec4fd2eda72" args_pointer1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_pointer1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_pointer1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_01b2f6502d340abe" args_pointer2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Ptr.Ptr FC.CInt)) -> IO ()) {-| __C declaration:__ @args_pointer2@ @@ -1124,7 +1263,7 @@ foreign import ccall safe "hs_bindgen_42ce2ec4fd2eda72" args_pointer1 :: __unique:__ @test_macrosreparse_Example_Safe_args_pointer2@ -} -foreign import ccall safe "hs_bindgen_01b2f6502d340abe" args_pointer2 :: +args_pointer2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1132,6 +1271,13 @@ foreign import ccall safe "hs_bindgen_01b2f6502d340abe" args_pointer2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_pointer2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_pointer2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3e64133f9aaebbf1" args_pointer3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Void) -> IO ()) {-| __C declaration:__ @args_pointer3@ @@ -1141,7 +1287,7 @@ foreign import ccall safe "hs_bindgen_01b2f6502d340abe" args_pointer2 :: __unique:__ @test_macrosreparse_Example_Safe_args_pointer3@ -} -foreign import ccall safe "hs_bindgen_3e64133f9aaebbf1" args_pointer3 :: +args_pointer3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1149,6 +1295,13 @@ foreign import ccall safe "hs_bindgen_3e64133f9aaebbf1" args_pointer3 :: {- ^ __C declaration:__ @arg3@ -} -> IO () +args_pointer3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_pointer3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c830401b459192fb" ret_A_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO A) {-| __C declaration:__ @ret_A@ @@ -1158,8 +1311,15 @@ foreign import ccall safe "hs_bindgen_3e64133f9aaebbf1" args_pointer3 :: __unique:__ @test_macrosreparse_Example_Safe_ret_A@ -} -foreign import ccall safe "hs_bindgen_c830401b459192fb" ret_A :: +ret_A :: IO A +ret_A = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_A_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_18b24c6e67a5412e" ret_char1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CChar) {-| __C declaration:__ @ret_char1@ @@ -1169,11 +1329,18 @@ foreign import ccall safe "hs_bindgen_c830401b459192fb" ret_A :: __unique:__ @test_macrosreparse_Example_Safe_ret_char1@ -} -foreign import ccall safe "hs_bindgen_18b24c6e67a5412e" ret_char1 :: +ret_char1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CChar +ret_char1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_char1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2da1160aeef9ff64" ret_char2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CSChar) {-| __C declaration:__ @ret_char2@ @@ -1183,11 +1350,18 @@ foreign import ccall safe "hs_bindgen_18b24c6e67a5412e" ret_char1 :: __unique:__ @test_macrosreparse_Example_Safe_ret_char2@ -} -foreign import ccall safe "hs_bindgen_2da1160aeef9ff64" ret_char2 :: +ret_char2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CSChar +ret_char2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_char2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e3183f9de1b9f231" ret_char3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CUChar) {-| __C declaration:__ @ret_char3@ @@ -1197,11 +1371,18 @@ foreign import ccall safe "hs_bindgen_2da1160aeef9ff64" ret_char2 :: __unique:__ @test_macrosreparse_Example_Safe_ret_char3@ -} -foreign import ccall safe "hs_bindgen_e3183f9de1b9f231" ret_char3 :: +ret_char3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CUChar +ret_char3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_char3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c313966d4478e3f4" ret_short1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CShort) {-| __C declaration:__ @ret_short1@ @@ -1211,11 +1392,18 @@ foreign import ccall safe "hs_bindgen_e3183f9de1b9f231" ret_char3 :: __unique:__ @test_macrosreparse_Example_Safe_ret_short1@ -} -foreign import ccall safe "hs_bindgen_c313966d4478e3f4" ret_short1 :: +ret_short1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CShort +ret_short1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_short1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_737fbec310eb0719" ret_short2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CShort) {-| __C declaration:__ @ret_short2@ @@ -1225,11 +1413,18 @@ foreign import ccall safe "hs_bindgen_c313966d4478e3f4" ret_short1 :: __unique:__ @test_macrosreparse_Example_Safe_ret_short2@ -} -foreign import ccall safe "hs_bindgen_737fbec310eb0719" ret_short2 :: +ret_short2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CShort +ret_short2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_short2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b5bd9e111020db4e" ret_short3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CUShort) {-| __C declaration:__ @ret_short3@ @@ -1239,11 +1434,18 @@ foreign import ccall safe "hs_bindgen_737fbec310eb0719" ret_short2 :: __unique:__ @test_macrosreparse_Example_Safe_ret_short3@ -} -foreign import ccall safe "hs_bindgen_b5bd9e111020db4e" ret_short3 :: +ret_short3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CUShort +ret_short3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_short3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a30224259287f5f8" ret_int1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CInt) {-| __C declaration:__ @ret_int1@ @@ -1253,11 +1455,18 @@ foreign import ccall safe "hs_bindgen_b5bd9e111020db4e" ret_short3 :: __unique:__ @test_macrosreparse_Example_Safe_ret_int1@ -} -foreign import ccall safe "hs_bindgen_a30224259287f5f8" ret_int1 :: +ret_int1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CInt +ret_int1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_int1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b5be09caf8cf5750" ret_int2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CInt) {-| __C declaration:__ @ret_int2@ @@ -1267,11 +1476,18 @@ foreign import ccall safe "hs_bindgen_a30224259287f5f8" ret_int1 :: __unique:__ @test_macrosreparse_Example_Safe_ret_int2@ -} -foreign import ccall safe "hs_bindgen_b5be09caf8cf5750" ret_int2 :: +ret_int2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CInt +ret_int2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_int2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_698e3f97470d83be" ret_int3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CUInt) {-| __C declaration:__ @ret_int3@ @@ -1281,11 +1497,18 @@ foreign import ccall safe "hs_bindgen_b5be09caf8cf5750" ret_int2 :: __unique:__ @test_macrosreparse_Example_Safe_ret_int3@ -} -foreign import ccall safe "hs_bindgen_698e3f97470d83be" ret_int3 :: +ret_int3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CUInt +ret_int3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_int3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c7e0705dd09be530" ret_long1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CLong) {-| __C declaration:__ @ret_long1@ @@ -1295,11 +1518,18 @@ foreign import ccall safe "hs_bindgen_698e3f97470d83be" ret_int3 :: __unique:__ @test_macrosreparse_Example_Safe_ret_long1@ -} -foreign import ccall safe "hs_bindgen_c7e0705dd09be530" ret_long1 :: +ret_long1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CLong +ret_long1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_long1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_74b1f5b8c56ff22c" ret_long2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CLong) {-| __C declaration:__ @ret_long2@ @@ -1309,11 +1539,18 @@ foreign import ccall safe "hs_bindgen_c7e0705dd09be530" ret_long1 :: __unique:__ @test_macrosreparse_Example_Safe_ret_long2@ -} -foreign import ccall safe "hs_bindgen_74b1f5b8c56ff22c" ret_long2 :: +ret_long2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CLong +ret_long2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_long2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c2d07eaaab82d408" ret_long3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CULong) {-| __C declaration:__ @ret_long3@ @@ -1323,11 +1560,18 @@ foreign import ccall safe "hs_bindgen_74b1f5b8c56ff22c" ret_long2 :: __unique:__ @test_macrosreparse_Example_Safe_ret_long3@ -} -foreign import ccall safe "hs_bindgen_c2d07eaaab82d408" ret_long3 :: +ret_long3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CULong +ret_long3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_long3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0edfbc7067faa1f7" ret_float_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CFloat) {-| __C declaration:__ @ret_float@ @@ -1337,11 +1581,18 @@ foreign import ccall safe "hs_bindgen_c2d07eaaab82d408" ret_long3 :: __unique:__ @test_macrosreparse_Example_Safe_ret_float@ -} -foreign import ccall safe "hs_bindgen_0edfbc7067faa1f7" ret_float :: +ret_float :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CFloat +ret_float = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_float_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_786ca672396b33be" ret_double_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CDouble) {-| __C declaration:__ @ret_double@ @@ -1351,11 +1602,18 @@ foreign import ccall safe "hs_bindgen_0edfbc7067faa1f7" ret_float :: __unique:__ @test_macrosreparse_Example_Safe_ret_double@ -} -foreign import ccall safe "hs_bindgen_786ca672396b33be" ret_double :: +ret_double :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CDouble +ret_double = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_double_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2e99f19b59650996" ret_bool1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CBool) {-| __C declaration:__ @ret_bool1@ @@ -1365,20 +1623,29 @@ foreign import ccall safe "hs_bindgen_786ca672396b33be" ret_double :: __unique:__ @test_macrosreparse_Example_Safe_ret_bool1@ -} -foreign import ccall safe "hs_bindgen_2e99f19b59650996" ret_bool1 :: +ret_bool1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CBool +ret_bool1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_bool1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6c999121eed8178f" ret_struct_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_struct) -> IO ()) {-| Pointer-based API for 'ret_struct' __unique:__ @test_macrosreparse_Example_Safe_ret_struct@ -} -foreign import ccall safe "hs_bindgen_6c999121eed8178f" ret_struct_wrapper :: +ret_struct_wrapper :: A -> Ptr.Ptr Some_struct -> IO () +ret_struct_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_struct_wrapper_base {-| __C declaration:__ @ret_struct@ @@ -1396,14 +1663,21 @@ ret_struct = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> ret_struct_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_481ee5d2d9bd34db" ret_union_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_union) -> IO ()) + {-| Pointer-based API for 'ret_union' __unique:__ @test_macrosreparse_Example_Safe_ret_union@ -} -foreign import ccall safe "hs_bindgen_481ee5d2d9bd34db" ret_union_wrapper :: +ret_union_wrapper :: A -> Ptr.Ptr Some_union -> IO () +ret_union_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_union_wrapper_base {-| __C declaration:__ @ret_union@ @@ -1421,6 +1695,11 @@ ret_union = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> ret_union_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8bb240ba453b700d" ret_enum_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO Some_enum) + {-| __C declaration:__ @ret_enum@ __defined at:__ @macros\/reparse.h:71:20@ @@ -1429,11 +1708,18 @@ ret_union = __unique:__ @test_macrosreparse_Example_Safe_ret_enum@ -} -foreign import ccall safe "hs_bindgen_8bb240ba453b700d" ret_enum :: +ret_enum :: A {- ^ __C declaration:__ @arg1@ -} -> IO Some_enum +ret_enum = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_enum_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c346ed2cd20b9af1" ret_pointer1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @ret_pointer1@ @@ -1443,11 +1729,18 @@ foreign import ccall safe "hs_bindgen_8bb240ba453b700d" ret_enum :: __unique:__ @test_macrosreparse_Example_Safe_ret_pointer1@ -} -foreign import ccall safe "hs_bindgen_c346ed2cd20b9af1" ret_pointer1 :: +ret_pointer1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +ret_pointer1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_pointer1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a21f618658151728" ret_pointer2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) {-| __C declaration:__ @ret_pointer2@ @@ -1457,11 +1750,18 @@ foreign import ccall safe "hs_bindgen_c346ed2cd20b9af1" ret_pointer1 :: __unique:__ @test_macrosreparse_Example_Safe_ret_pointer2@ -} -foreign import ccall safe "hs_bindgen_a21f618658151728" ret_pointer2 :: +ret_pointer2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr (Ptr.Ptr FC.CInt)) +ret_pointer2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_pointer2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2d8c6e2d2f395342" ret_pointer3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @ret_pointer3@ @@ -1471,11 +1771,18 @@ foreign import ccall safe "hs_bindgen_a21f618658151728" ret_pointer2 :: __unique:__ @test_macrosreparse_Example_Safe_ret_pointer3@ -} -foreign import ccall safe "hs_bindgen_2d8c6e2d2f395342" ret_pointer3 :: +ret_pointer3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr Void) +ret_pointer3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_pointer3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b030d02030ed80bc" body1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CInt) {-| __C declaration:__ @body1@ @@ -1485,11 +1792,18 @@ foreign import ccall safe "hs_bindgen_2d8c6e2d2f395342" ret_pointer3 :: __unique:__ @test_macrosreparse_Example_Safe_body1@ -} -foreign import ccall safe "hs_bindgen_b030d02030ed80bc" body1 :: +body1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CInt +body1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType body1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_be50427e6a63df54" body2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO A) {-| __C declaration:__ @body2@ @@ -1499,17 +1813,26 @@ foreign import ccall safe "hs_bindgen_b030d02030ed80bc" body1 :: __unique:__ @test_macrosreparse_Example_Safe_body2@ -} -foreign import ccall safe "hs_bindgen_be50427e6a63df54" body2 :: +body2 :: IO A +body2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType body2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_627a52a5c7617083" args_complex_float_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> IO ()) {-| Pointer-based API for 'args_complex_float' __unique:__ @test_macrosreparse_Example_Safe_args_complex_float@ -} -foreign import ccall safe "hs_bindgen_627a52a5c7617083" args_complex_float_wrapper :: +args_complex_float_wrapper :: A -> Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> IO () +args_complex_float_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_complex_float_wrapper_base {-| __C declaration:__ @args_complex_float@ @@ -1530,14 +1853,21 @@ args_complex_float = \x1 -> F.with x1 (\y2 -> args_complex_float_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_392babebc1d83503" args_complex_double_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> IO ()) + {-| Pointer-based API for 'args_complex_double' __unique:__ @test_macrosreparse_Example_Safe_args_complex_double@ -} -foreign import ccall safe "hs_bindgen_392babebc1d83503" args_complex_double_wrapper :: +args_complex_double_wrapper :: A -> Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> IO () +args_complex_double_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_complex_double_wrapper_base {-| __C declaration:__ @args_complex_double@ @@ -1558,14 +1888,21 @@ args_complex_double = \x1 -> F.with x1 (\y2 -> args_complex_double_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8958183ede73dea8" ret_complex_float_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> IO ()) + {-| Pointer-based API for 'ret_complex_float' __unique:__ @test_macrosreparse_Example_Safe_ret_complex_float@ -} -foreign import ccall safe "hs_bindgen_8958183ede73dea8" ret_complex_float_wrapper :: +ret_complex_float_wrapper :: A -> Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> IO () +ret_complex_float_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_complex_float_wrapper_base {-| __C declaration:__ @ret_complex_float@ @@ -1583,14 +1920,21 @@ ret_complex_float = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> ret_complex_float_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a95fabfd391a99aa" ret_complex_double_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> IO ()) + {-| Pointer-based API for 'ret_complex_double' __unique:__ @test_macrosreparse_Example_Safe_ret_complex_double@ -} -foreign import ccall safe "hs_bindgen_a95fabfd391a99aa" ret_complex_double_wrapper :: +ret_complex_double_wrapper :: A -> Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> IO () +ret_complex_double_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_complex_double_wrapper_base {-| __C declaration:__ @ret_complex_double@ @@ -1608,6 +1952,11 @@ ret_complex_double = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> ret_complex_double_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ad9f8630dd04a203" bespoke_args1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) + {-| __C declaration:__ @bespoke_args1@ __defined at:__ @macros\/reparse.h:94:6@ @@ -1616,7 +1965,7 @@ ret_complex_double = __unique:__ @test_macrosreparse_Example_Safe_bespoke_args1@ -} -foreign import ccall safe "hs_bindgen_ad9f8630dd04a203" bespoke_args1 :: +bespoke_args1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1624,6 +1973,13 @@ foreign import ccall safe "hs_bindgen_ad9f8630dd04a203" bespoke_args1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +bespoke_args1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bespoke_args1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4b34178a505131e2" bespoke_args2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()) {-| __C declaration:__ @bespoke_args2@ @@ -1633,7 +1989,7 @@ foreign import ccall safe "hs_bindgen_ad9f8630dd04a203" bespoke_args1 :: __unique:__ @test_macrosreparse_Example_Safe_bespoke_args2@ -} -foreign import ccall safe "hs_bindgen_4b34178a505131e2" bespoke_args2 :: +bespoke_args2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1641,6 +1997,13 @@ foreign import ccall safe "hs_bindgen_4b34178a505131e2" bespoke_args2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +bespoke_args2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bespoke_args2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_94b225a6394496c1" bespoke_ret1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CBool) {-| __C declaration:__ @bespoke_ret1@ @@ -1650,11 +2013,18 @@ foreign import ccall safe "hs_bindgen_4b34178a505131e2" bespoke_args2 :: __unique:__ @test_macrosreparse_Example_Safe_bespoke_ret1@ -} -foreign import ccall safe "hs_bindgen_94b225a6394496c1" bespoke_ret1 :: +bespoke_ret1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CBool +bespoke_ret1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bespoke_ret1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7c9a1792426b84a1" bespoke_ret2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO HsBindgen.Runtime.Prelude.CSize) {-| __C declaration:__ @bespoke_ret2@ @@ -1664,11 +2034,18 @@ foreign import ccall safe "hs_bindgen_94b225a6394496c1" bespoke_ret1 :: __unique:__ @test_macrosreparse_Example_Safe_bespoke_ret2@ -} -foreign import ccall safe "hs_bindgen_7c9a1792426b84a1" bespoke_ret2 :: +bespoke_ret2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO HsBindgen.Runtime.Prelude.CSize +bespoke_ret2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bespoke_ret2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e20689fe39004225" arr_args1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr A) -> IO ()) {-| Arrays @@ -1680,11 +2057,18 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Safe_arr_args1@ -} -foreign import ccall safe "hs_bindgen_e20689fe39004225" arr_args1 :: +arr_args1 :: Ptr.Ptr A {- ^ __C declaration:__ @arg1@ -} -> IO () +arr_args1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType arr_args1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_084796e4bfd3f4cd" arr_args2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr A)) -> IO ()) {-| __C declaration:__ @arr_args2@ @@ -1694,11 +2078,18 @@ foreign import ccall safe "hs_bindgen_e20689fe39004225" arr_args1 :: __unique:__ @test_macrosreparse_Example_Safe_arr_args2@ -} -foreign import ccall safe "hs_bindgen_084796e4bfd3f4cd" arr_args2 :: +arr_args2 :: Ptr.Ptr (Ptr.Ptr A) {- ^ __C declaration:__ @arg1@ -} -> IO () +arr_args2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType arr_args2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a3d1560aaa4352df" arr_args3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr A) -> IO ()) {-| __C declaration:__ @arr_args3@ @@ -1708,11 +2099,18 @@ foreign import ccall safe "hs_bindgen_084796e4bfd3f4cd" arr_args2 :: __unique:__ @test_macrosreparse_Example_Safe_arr_args3@ -} -foreign import ccall safe "hs_bindgen_a3d1560aaa4352df" arr_args3 :: +arr_args3 :: Ptr.Ptr A {- ^ __C declaration:__ @arg1@ -} -> IO () +arr_args3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType arr_args3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_88659ccccc6c1f5f" arr_args4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr A)) -> IO ()) {-| __C declaration:__ @arr_args4@ @@ -1722,11 +2120,18 @@ foreign import ccall safe "hs_bindgen_a3d1560aaa4352df" arr_args3 :: __unique:__ @test_macrosreparse_Example_Safe_arr_args4@ -} -foreign import ccall safe "hs_bindgen_88659ccccc6c1f5f" arr_args4 :: +arr_args4 :: Ptr.Ptr (Ptr.Ptr A) {- ^ __C declaration:__ @arg1@ -} -> IO () +arr_args4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType arr_args4_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3448d03cfd41161a" funptr_args1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (IO ())) -> IO ()) {-| Function pointers @@ -1738,7 +2143,7 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Safe_funptr_args1@ -} -foreign import ccall safe "hs_bindgen_3448d03cfd41161a" funptr_args1 :: +funptr_args1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1746,6 +2151,13 @@ foreign import ccall safe "hs_bindgen_3448d03cfd41161a" funptr_args1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_92d7386f0a327d25" funptr_args2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ()) {-| __C declaration:__ @funptr_args2@ @@ -1755,7 +2167,7 @@ foreign import ccall safe "hs_bindgen_3448d03cfd41161a" funptr_args1 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_args2@ -} -foreign import ccall safe "hs_bindgen_92d7386f0a327d25" funptr_args2 :: +funptr_args2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1763,6 +2175,13 @@ foreign import ccall safe "hs_bindgen_92d7386f0a327d25" funptr_args2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2881f594f98043e6" funptr_args3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (FC.CInt -> IO ())) -> IO ()) {-| __C declaration:__ @funptr_args3@ @@ -1772,7 +2191,7 @@ foreign import ccall safe "hs_bindgen_92d7386f0a327d25" funptr_args2 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_args3@ -} -foreign import ccall safe "hs_bindgen_2881f594f98043e6" funptr_args3 :: +funptr_args3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1780,6 +2199,13 @@ foreign import ccall safe "hs_bindgen_2881f594f98043e6" funptr_args3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1e85a05df4251f62" funptr_args4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar)) -> IO ()) {-| __C declaration:__ @funptr_args4@ @@ -1789,7 +2215,7 @@ foreign import ccall safe "hs_bindgen_2881f594f98043e6" funptr_args3 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_args4@ -} -foreign import ccall safe "hs_bindgen_1e85a05df4251f62" funptr_args4 :: +funptr_args4 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1797,6 +2223,13 @@ foreign import ccall safe "hs_bindgen_1e85a05df4251f62" funptr_args4 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args4_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ccf4db7511f0d6d6" funptr_args5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) -> IO ()) {-| __C declaration:__ @funptr_args5@ @@ -1806,7 +2239,7 @@ foreign import ccall safe "hs_bindgen_1e85a05df4251f62" funptr_args4 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_args5@ -} -foreign import ccall safe "hs_bindgen_ccf4db7511f0d6d6" funptr_args5 :: +funptr_args5 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1814,6 +2247,13 @@ foreign import ccall safe "hs_bindgen_ccf4db7511f0d6d6" funptr_args5 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args5_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4c756db60673d221" comments1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO ()) {-| Comments in awkward places @@ -1827,11 +2267,18 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Safe_comments1@ -} -foreign import ccall safe "hs_bindgen_4c756db60673d221" comments1 :: +comments1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO () +comments1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType comments1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_278568d7a2a3a4b6" const_prim_before1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CChar -> IO ()) {-| `const` qualifier @@ -1845,7 +2292,7 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Safe_const_prim_before1@ -} -foreign import ccall safe "hs_bindgen_278568d7a2a3a4b6" const_prim_before1 :: +const_prim_before1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1853,6 +2300,13 @@ foreign import ccall safe "hs_bindgen_278568d7a2a3a4b6" const_prim_before1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_before1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_before1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_87ee56525e5ea20c" const_prim_before2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CSChar -> IO ()) {-| __C declaration:__ @const_prim_before2@ @@ -1862,7 +2316,7 @@ foreign import ccall safe "hs_bindgen_278568d7a2a3a4b6" const_prim_before1 :: __unique:__ @test_macrosreparse_Example_Safe_const_prim_before2@ -} -foreign import ccall safe "hs_bindgen_87ee56525e5ea20c" const_prim_before2 :: +const_prim_before2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1870,6 +2324,13 @@ foreign import ccall safe "hs_bindgen_87ee56525e5ea20c" const_prim_before2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_before2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_before2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c0b99594235bd99e" const_prim_before3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUChar -> IO ()) {-| __C declaration:__ @const_prim_before3@ @@ -1879,7 +2340,7 @@ foreign import ccall safe "hs_bindgen_87ee56525e5ea20c" const_prim_before2 :: __unique:__ @test_macrosreparse_Example_Safe_const_prim_before3@ -} -foreign import ccall safe "hs_bindgen_c0b99594235bd99e" const_prim_before3 :: +const_prim_before3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1887,6 +2348,13 @@ foreign import ccall safe "hs_bindgen_c0b99594235bd99e" const_prim_before3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_before3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_before3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d718b682f157fc18" const_prim_after1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CChar -> IO ()) {-| __C declaration:__ @const_prim_after1@ @@ -1896,7 +2364,7 @@ foreign import ccall safe "hs_bindgen_c0b99594235bd99e" const_prim_before3 :: __unique:__ @test_macrosreparse_Example_Safe_const_prim_after1@ -} -foreign import ccall safe "hs_bindgen_d718b682f157fc18" const_prim_after1 :: +const_prim_after1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1904,6 +2372,13 @@ foreign import ccall safe "hs_bindgen_d718b682f157fc18" const_prim_after1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_after1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_after1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f2c5b3d5eca68433" const_prim_after2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CSChar -> IO ()) {-| __C declaration:__ @const_prim_after2@ @@ -1913,7 +2388,7 @@ foreign import ccall safe "hs_bindgen_d718b682f157fc18" const_prim_after1 :: __unique:__ @test_macrosreparse_Example_Safe_const_prim_after2@ -} -foreign import ccall safe "hs_bindgen_f2c5b3d5eca68433" const_prim_after2 :: +const_prim_after2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1921,6 +2396,13 @@ foreign import ccall safe "hs_bindgen_f2c5b3d5eca68433" const_prim_after2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_after2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_after2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ae2d994e06667b23" const_prim_after3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUChar -> IO ()) {-| __C declaration:__ @const_prim_after3@ @@ -1930,7 +2412,7 @@ foreign import ccall safe "hs_bindgen_f2c5b3d5eca68433" const_prim_after2 :: __unique:__ @test_macrosreparse_Example_Safe_const_prim_after3@ -} -foreign import ccall safe "hs_bindgen_ae2d994e06667b23" const_prim_after3 :: +const_prim_after3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1938,6 +2420,13 @@ foreign import ccall safe "hs_bindgen_ae2d994e06667b23" const_prim_after3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_after3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_after3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6940b58e7f4397a7" const_withoutSign_before1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CFloat -> IO ()) {-| __C declaration:__ @const_withoutSign_before1@ @@ -1947,7 +2436,7 @@ foreign import ccall safe "hs_bindgen_ae2d994e06667b23" const_prim_after3 :: __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_before1@ -} -foreign import ccall safe "hs_bindgen_6940b58e7f4397a7" const_withoutSign_before1 :: +const_withoutSign_before1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1955,6 +2444,13 @@ foreign import ccall safe "hs_bindgen_6940b58e7f4397a7" const_withoutSign_before {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_00b6fe2282e779b1" const_withoutSign_before2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CDouble -> IO ()) {-| __C declaration:__ @const_withoutSign_before2@ @@ -1964,7 +2460,7 @@ foreign import ccall safe "hs_bindgen_6940b58e7f4397a7" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_before2@ -} -foreign import ccall safe "hs_bindgen_00b6fe2282e779b1" const_withoutSign_before2 :: +const_withoutSign_before2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1972,6 +2468,13 @@ foreign import ccall safe "hs_bindgen_00b6fe2282e779b1" const_withoutSign_before {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6517cc8d39aead93" const_withoutSign_before3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @const_withoutSign_before3@ @@ -1981,7 +2484,7 @@ foreign import ccall safe "hs_bindgen_00b6fe2282e779b1" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_before3@ -} -foreign import ccall safe "hs_bindgen_6517cc8d39aead93" const_withoutSign_before3 :: +const_withoutSign_before3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1989,15 +2492,24 @@ foreign import ccall safe "hs_bindgen_6517cc8d39aead93" const_withoutSign_before {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_68c7661e95060488" const_withoutSign_before4_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_struct) -> IO ()) {-| Pointer-based API for 'const_withoutSign_before4' __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_before4@ -} -foreign import ccall safe "hs_bindgen_68c7661e95060488" const_withoutSign_before4_wrapper :: +const_withoutSign_before4_wrapper :: A -> Ptr.Ptr Some_struct -> IO () +const_withoutSign_before4_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before4_wrapper_base {-| __C declaration:__ @const_withoutSign_before4@ @@ -2019,14 +2531,21 @@ const_withoutSign_before4 = F.with x1 (\y2 -> const_withoutSign_before4_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_42b3b0bf73a7a51a" const_withoutSign_before5_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_union) -> IO ()) + {-| Pointer-based API for 'const_withoutSign_before5' __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_before5@ -} -foreign import ccall safe "hs_bindgen_42b3b0bf73a7a51a" const_withoutSign_before5_wrapper :: +const_withoutSign_before5_wrapper :: A -> Ptr.Ptr Some_union -> IO () +const_withoutSign_before5_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before5_wrapper_base {-| __C declaration:__ @const_withoutSign_before5@ @@ -2048,6 +2567,11 @@ const_withoutSign_before5 = F.with x1 (\y2 -> const_withoutSign_before5_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c4aabe9834aac12f" const_withoutSign_before6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> Some_enum -> IO ()) + {-| __C declaration:__ @const_withoutSign_before6@ __defined at:__ @macros\/reparse.h:193:6@ @@ -2056,7 +2580,7 @@ const_withoutSign_before5 = __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_before6@ -} -foreign import ccall safe "hs_bindgen_c4aabe9834aac12f" const_withoutSign_before6 :: +const_withoutSign_before6 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2064,6 +2588,13 @@ foreign import ccall safe "hs_bindgen_c4aabe9834aac12f" const_withoutSign_before {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before6_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_486090a7fb4e34d4" const_withoutSign_before7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @const_withoutSign_before7@ @@ -2073,7 +2604,7 @@ foreign import ccall safe "hs_bindgen_c4aabe9834aac12f" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_before7@ -} -foreign import ccall safe "hs_bindgen_486090a7fb4e34d4" const_withoutSign_before7 :: +const_withoutSign_before7 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2081,6 +2612,13 @@ foreign import ccall safe "hs_bindgen_486090a7fb4e34d4" const_withoutSign_before {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before7_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_23fa742b614176dd" const_withoutSign_before8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()) {-| __C declaration:__ @const_withoutSign_before8@ @@ -2090,7 +2628,7 @@ foreign import ccall safe "hs_bindgen_486090a7fb4e34d4" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_before8@ -} -foreign import ccall safe "hs_bindgen_23fa742b614176dd" const_withoutSign_before8 :: +const_withoutSign_before8 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2098,6 +2636,13 @@ foreign import ccall safe "hs_bindgen_23fa742b614176dd" const_withoutSign_before {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before8_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0aacd8a5d48f296d" const_withoutSign_after1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CFloat -> IO ()) {-| __C declaration:__ @const_withoutSign_after1@ @@ -2107,7 +2652,7 @@ foreign import ccall safe "hs_bindgen_23fa742b614176dd" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_after1@ -} -foreign import ccall safe "hs_bindgen_0aacd8a5d48f296d" const_withoutSign_after1 :: +const_withoutSign_after1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2115,6 +2660,13 @@ foreign import ccall safe "hs_bindgen_0aacd8a5d48f296d" const_withoutSign_after1 {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_16ec2102221485b7" const_withoutSign_after2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CDouble -> IO ()) {-| __C declaration:__ @const_withoutSign_after2@ @@ -2124,7 +2676,7 @@ foreign import ccall safe "hs_bindgen_0aacd8a5d48f296d" const_withoutSign_after1 __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_after2@ -} -foreign import ccall safe "hs_bindgen_16ec2102221485b7" const_withoutSign_after2 :: +const_withoutSign_after2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2132,6 +2684,13 @@ foreign import ccall safe "hs_bindgen_16ec2102221485b7" const_withoutSign_after2 {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9aa934d44ec3790c" const_withoutSign_after3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @const_withoutSign_after3@ @@ -2141,7 +2700,7 @@ foreign import ccall safe "hs_bindgen_16ec2102221485b7" const_withoutSign_after2 __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_after3@ -} -foreign import ccall safe "hs_bindgen_9aa934d44ec3790c" const_withoutSign_after3 :: +const_withoutSign_after3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2149,15 +2708,24 @@ foreign import ccall safe "hs_bindgen_9aa934d44ec3790c" const_withoutSign_after3 {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_043d2869e29bedcf" const_withoutSign_after4_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_struct) -> IO ()) {-| Pointer-based API for 'const_withoutSign_after4' __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_after4@ -} -foreign import ccall safe "hs_bindgen_043d2869e29bedcf" const_withoutSign_after4_wrapper :: +const_withoutSign_after4_wrapper :: A -> Ptr.Ptr Some_struct -> IO () +const_withoutSign_after4_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after4_wrapper_base {-| __C declaration:__ @const_withoutSign_after4@ @@ -2179,14 +2747,21 @@ const_withoutSign_after4 = F.with x1 (\y2 -> const_withoutSign_after4_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b5f9bca1de9d69de" const_withoutSign_after5_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_union) -> IO ()) + {-| Pointer-based API for 'const_withoutSign_after5' __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_after5@ -} -foreign import ccall safe "hs_bindgen_b5f9bca1de9d69de" const_withoutSign_after5_wrapper :: +const_withoutSign_after5_wrapper :: A -> Ptr.Ptr Some_union -> IO () +const_withoutSign_after5_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after5_wrapper_base {-| __C declaration:__ @const_withoutSign_after5@ @@ -2208,6 +2783,11 @@ const_withoutSign_after5 = F.with x1 (\y2 -> const_withoutSign_after5_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_77d641d518b2504f" const_withoutSign_after6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> Some_enum -> IO ()) + {-| __C declaration:__ @const_withoutSign_after6@ __defined at:__ @macros\/reparse.h:202:6@ @@ -2216,7 +2796,7 @@ const_withoutSign_after5 = __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_after6@ -} -foreign import ccall safe "hs_bindgen_77d641d518b2504f" const_withoutSign_after6 :: +const_withoutSign_after6 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2224,6 +2804,13 @@ foreign import ccall safe "hs_bindgen_77d641d518b2504f" const_withoutSign_after6 {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after6_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_691b4f2909140b49" const_withoutSign_after7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @const_withoutSign_after7@ @@ -2233,7 +2820,7 @@ foreign import ccall safe "hs_bindgen_77d641d518b2504f" const_withoutSign_after6 __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_after7@ -} -foreign import ccall safe "hs_bindgen_691b4f2909140b49" const_withoutSign_after7 :: +const_withoutSign_after7 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2241,6 +2828,13 @@ foreign import ccall safe "hs_bindgen_691b4f2909140b49" const_withoutSign_after7 {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after7_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ae74c8dcdc2ec9eb" const_withoutSign_after8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()) {-| __C declaration:__ @const_withoutSign_after8@ @@ -2250,7 +2844,7 @@ foreign import ccall safe "hs_bindgen_691b4f2909140b49" const_withoutSign_after7 __unique:__ @test_macrosreparse_Example_Safe_const_withoutSign_after8@ -} -foreign import ccall safe "hs_bindgen_ae74c8dcdc2ec9eb" const_withoutSign_after8 :: +const_withoutSign_after8 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2258,6 +2852,13 @@ foreign import ccall safe "hs_bindgen_ae74c8dcdc2ec9eb" const_withoutSign_after8 {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after8_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_07606c41eadf9146" const_pointers_args1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args1@ @@ -2267,7 +2868,7 @@ foreign import ccall safe "hs_bindgen_ae74c8dcdc2ec9eb" const_withoutSign_after8 __unique:__ @test_macrosreparse_Example_Safe_const_pointers_args1@ -} -foreign import ccall safe "hs_bindgen_07606c41eadf9146" const_pointers_args1 :: +const_pointers_args1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2275,6 +2876,13 @@ foreign import ccall safe "hs_bindgen_07606c41eadf9146" const_pointers_args1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3836769f3a3416ac" const_pointers_args2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args2@ @@ -2284,7 +2892,7 @@ foreign import ccall safe "hs_bindgen_07606c41eadf9146" const_pointers_args1 :: __unique:__ @test_macrosreparse_Example_Safe_const_pointers_args2@ -} -foreign import ccall safe "hs_bindgen_3836769f3a3416ac" const_pointers_args2 :: +const_pointers_args2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2292,6 +2900,13 @@ foreign import ccall safe "hs_bindgen_3836769f3a3416ac" const_pointers_args2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_12f19ea593aefd3f" const_pointers_args3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args3@ @@ -2301,7 +2916,7 @@ foreign import ccall safe "hs_bindgen_3836769f3a3416ac" const_pointers_args2 :: __unique:__ @test_macrosreparse_Example_Safe_const_pointers_args3@ -} -foreign import ccall safe "hs_bindgen_12f19ea593aefd3f" const_pointers_args3 :: +const_pointers_args3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2309,6 +2924,13 @@ foreign import ccall safe "hs_bindgen_12f19ea593aefd3f" const_pointers_args3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5a50e98897696d57" const_pointers_args4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args4@ @@ -2318,7 +2940,7 @@ foreign import ccall safe "hs_bindgen_12f19ea593aefd3f" const_pointers_args3 :: __unique:__ @test_macrosreparse_Example_Safe_const_pointers_args4@ -} -foreign import ccall safe "hs_bindgen_5a50e98897696d57" const_pointers_args4 :: +const_pointers_args4 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2326,6 +2948,13 @@ foreign import ccall safe "hs_bindgen_5a50e98897696d57" const_pointers_args4 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args4_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_666701f7cb61bd15" const_pointers_args5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args5@ @@ -2335,7 +2964,7 @@ foreign import ccall safe "hs_bindgen_5a50e98897696d57" const_pointers_args4 :: __unique:__ @test_macrosreparse_Example_Safe_const_pointers_args5@ -} -foreign import ccall safe "hs_bindgen_666701f7cb61bd15" const_pointers_args5 :: +const_pointers_args5 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2343,6 +2972,13 @@ foreign import ccall safe "hs_bindgen_666701f7cb61bd15" const_pointers_args5 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args5_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b94fbc3dfd285563" const_pointers_ret1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret1@ @@ -2352,11 +2988,18 @@ foreign import ccall safe "hs_bindgen_666701f7cb61bd15" const_pointers_args5 :: __unique:__ @test_macrosreparse_Example_Safe_const_pointers_ret1@ -} -foreign import ccall safe "hs_bindgen_b94fbc3dfd285563" const_pointers_ret1 :: +const_pointers_ret1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_33e2960e26b79450" const_pointers_ret2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret2@ @@ -2366,11 +3009,18 @@ foreign import ccall safe "hs_bindgen_b94fbc3dfd285563" const_pointers_ret1 :: __unique:__ @test_macrosreparse_Example_Safe_const_pointers_ret2@ -} -foreign import ccall safe "hs_bindgen_33e2960e26b79450" const_pointers_ret2 :: +const_pointers_ret2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_50c6e2fe4f3fb777" const_pointers_ret3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret3@ @@ -2380,11 +3030,18 @@ foreign import ccall safe "hs_bindgen_33e2960e26b79450" const_pointers_ret2 :: __unique:__ @test_macrosreparse_Example_Safe_const_pointers_ret3@ -} -foreign import ccall safe "hs_bindgen_50c6e2fe4f3fb777" const_pointers_ret3 :: +const_pointers_ret3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_edc014695d896c8d" const_pointers_ret4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret4@ @@ -2394,11 +3051,18 @@ foreign import ccall safe "hs_bindgen_50c6e2fe4f3fb777" const_pointers_ret3 :: __unique:__ @test_macrosreparse_Example_Safe_const_pointers_ret4@ -} -foreign import ccall safe "hs_bindgen_edc014695d896c8d" const_pointers_ret4 :: +const_pointers_ret4 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret4_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6d3308cc5847f033" const_pointers_ret5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret5@ @@ -2408,19 +3072,28 @@ foreign import ccall safe "hs_bindgen_edc014695d896c8d" const_pointers_ret4 :: __unique:__ @test_macrosreparse_Example_Safe_const_pointers_ret5@ -} -foreign import ccall safe "hs_bindgen_6d3308cc5847f033" const_pointers_ret5 :: +const_pointers_ret5 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret5_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_678576320923a4d1" const_array_elem1_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr A) -> IO ()) {-| Pointer-based API for 'const_array_elem1' __unique:__ @test_macrosreparse_Example_Safe_const_array_elem1@ -} -foreign import ccall safe "hs_bindgen_678576320923a4d1" const_array_elem1_wrapper :: +const_array_elem1_wrapper :: Ptr.Ptr A -> IO () +const_array_elem1_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_array_elem1_wrapper_base {-| __C declaration:__ @const_array_elem1@ @@ -2438,6 +3111,11 @@ const_array_elem1 = HsBindgen.Runtime.IncompleteArray.withPtr x0 (\ptr1 -> const_array_elem1_wrapper ptr1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b317941dde4eeff2" const_array_elem2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr A)) -> IO ()) + {-| __C declaration:__ @const_array_elem2@ __defined at:__ @macros\/reparse.h:247:6@ @@ -2446,19 +3124,28 @@ const_array_elem1 = __unique:__ @test_macrosreparse_Example_Safe_const_array_elem2@ -} -foreign import ccall safe "hs_bindgen_b317941dde4eeff2" const_array_elem2 :: +const_array_elem2 :: Ptr.Ptr (Ptr.Ptr A) {- ^ __C declaration:__ @arg1@ -} -> IO () +const_array_elem2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_array_elem2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_707e602e6beb1bb6" const_array_elem3_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr A)) -> IO ()) {-| Pointer-based API for 'const_array_elem3' __unique:__ @test_macrosreparse_Example_Safe_const_array_elem3@ -} -foreign import ccall safe "hs_bindgen_707e602e6beb1bb6" const_array_elem3_wrapper :: +const_array_elem3_wrapper :: Ptr.Ptr (Ptr.Ptr A) -> IO () +const_array_elem3_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_array_elem3_wrapper_base {-| __C declaration:__ @const_array_elem3@ @@ -2476,6 +3163,11 @@ const_array_elem3 = HsBindgen.Runtime.IncompleteArray.withPtr x0 (\ptr1 -> const_array_elem3_wrapper ptr1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_93fecb4eb766c262" noParams1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO A) + {-| Other examples we reparsed /incorrectly/ before language-c __C declaration:__ @noParams1@ @@ -2486,8 +3178,15 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Safe_noParams1@ -} -foreign import ccall safe "hs_bindgen_93fecb4eb766c262" noParams1 :: +noParams1 :: IO A +noParams1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType noParams1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4350965157c891f5" noParams2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO A) {-| __C declaration:__ @noParams2@ @@ -2497,8 +3196,15 @@ foreign import ccall safe "hs_bindgen_93fecb4eb766c262" noParams1 :: __unique:__ @test_macrosreparse_Example_Safe_noParams2@ -} -foreign import ccall safe "hs_bindgen_4350965157c891f5" noParams2 :: +noParams2 :: IO A +noParams2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType noParams2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c4f59272a2b1c3b5" noParams3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ()) {-| __C declaration:__ @noParams3@ @@ -2508,7 +3214,7 @@ foreign import ccall safe "hs_bindgen_4350965157c891f5" noParams2 :: __unique:__ @test_macrosreparse_Example_Safe_noParams3@ -} -foreign import ccall safe "hs_bindgen_c4f59272a2b1c3b5" noParams3 :: +noParams3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2516,6 +3222,13 @@ foreign import ccall safe "hs_bindgen_c4f59272a2b1c3b5" noParams3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +noParams3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType noParams3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_387a04c01e23c320" funptr_ret1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (IO ()))) {-| __C declaration:__ @funptr_ret1@ @@ -2525,11 +3238,18 @@ foreign import ccall safe "hs_bindgen_c4f59272a2b1c3b5" noParams3 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret1@ -} -foreign import ccall safe "hs_bindgen_387a04c01e23c320" funptr_ret1 :: +funptr_ret1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (IO ())) +funptr_ret1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6f0c14cd3478dc19" funptr_ret2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (IO FC.CInt))) {-| __C declaration:__ @funptr_ret2@ @@ -2539,11 +3259,18 @@ foreign import ccall safe "hs_bindgen_387a04c01e23c320" funptr_ret1 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret2@ -} -foreign import ccall safe "hs_bindgen_6f0c14cd3478dc19" funptr_ret2 :: +funptr_ret2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (IO FC.CInt)) +funptr_ret2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_08e8661d277cf7be" funptr_ret3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> IO ()))) {-| __C declaration:__ @funptr_ret3@ @@ -2553,11 +3280,18 @@ foreign import ccall safe "hs_bindgen_6f0c14cd3478dc19" funptr_ret2 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret3@ -} -foreign import ccall safe "hs_bindgen_08e8661d277cf7be" funptr_ret3 :: +funptr_ret3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> IO ())) +funptr_ret3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret3_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_609b5d953b68da92" funptr_ret4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar))) {-| __C declaration:__ @funptr_ret4@ @@ -2567,11 +3301,18 @@ foreign import ccall safe "hs_bindgen_08e8661d277cf7be" funptr_ret3 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret4@ -} -foreign import ccall safe "hs_bindgen_609b5d953b68da92" funptr_ret4 :: +funptr_ret4 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar)) +funptr_ret4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret4_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_13e6ae43abf40aee" funptr_ret5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret5@ @@ -2581,11 +3322,18 @@ foreign import ccall safe "hs_bindgen_609b5d953b68da92" funptr_ret4 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret5@ -} -foreign import ccall safe "hs_bindgen_13e6ae43abf40aee" funptr_ret5 :: +funptr_ret5 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret5_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a4a3a86f28ca6299" funptr_ret6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret6@ @@ -2595,11 +3343,18 @@ foreign import ccall safe "hs_bindgen_13e6ae43abf40aee" funptr_ret5 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret6@ -} -foreign import ccall safe "hs_bindgen_a4a3a86f28ca6299" funptr_ret6 :: +funptr_ret6 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret6_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eae9dff04c88d00b" funptr_ret7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret7@ @@ -2609,11 +3364,18 @@ foreign import ccall safe "hs_bindgen_a4a3a86f28ca6299" funptr_ret6 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret7@ -} -foreign import ccall safe "hs_bindgen_eae9dff04c88d00b" funptr_ret7 :: +funptr_ret7 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret7_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_894457d90a2fc8db" funptr_ret8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret8@ @@ -2623,11 +3385,18 @@ foreign import ccall safe "hs_bindgen_eae9dff04c88d00b" funptr_ret7 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret8@ -} -foreign import ccall safe "hs_bindgen_894457d90a2fc8db" funptr_ret8 :: +funptr_ret8 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret8_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c893eb15ad9bc68c" funptr_ret9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret9@ @@ -2637,11 +3406,18 @@ foreign import ccall safe "hs_bindgen_894457d90a2fc8db" funptr_ret8 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret9@ -} -foreign import ccall safe "hs_bindgen_c893eb15ad9bc68c" funptr_ret9 :: +funptr_ret9 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret9_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d96c258298a44b28" funptr_ret10_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret10@ @@ -2651,8 +3427,10 @@ foreign import ccall safe "hs_bindgen_c893eb15ad9bc68c" funptr_ret9 :: __unique:__ @test_macrosreparse_Example_Safe_funptr_ret10@ -} -foreign import ccall safe "hs_bindgen_d96c258298a44b28" funptr_ret10 :: +funptr_ret10 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret10 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret10_base diff --git a/hs-bindgen/fixtures/macros/reparse/Example/Unsafe.hs b/hs-bindgen/fixtures/macros/reparse/Example/Unsafe.hs index 6b74655e1..61994f224 100644 --- a/hs-bindgen/fixtures/macros/reparse/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/macros/reparse/Example/Unsafe.hs @@ -10,6 +10,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.CAPI +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) @@ -771,6 +772,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c1716e300ba327c7" args_char1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CChar -> IO ()) + {-| Function declarations __C declaration:__ @args_char1@ @@ -781,7 +787,7 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_args_char1@ -} -foreign import ccall unsafe "hs_bindgen_c1716e300ba327c7" args_char1 :: +args_char1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -789,6 +795,13 @@ foreign import ccall unsafe "hs_bindgen_c1716e300ba327c7" args_char1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_char1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_char1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3ef14607a6187aaa" args_char2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CSChar -> IO ()) {-| __C declaration:__ @args_char2@ @@ -798,7 +811,7 @@ foreign import ccall unsafe "hs_bindgen_c1716e300ba327c7" args_char1 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_char2@ -} -foreign import ccall unsafe "hs_bindgen_3ef14607a6187aaa" args_char2 :: +args_char2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -806,6 +819,13 @@ foreign import ccall unsafe "hs_bindgen_3ef14607a6187aaa" args_char2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_char2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_char2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5b0a626f64912f9d" args_char3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUChar -> IO ()) {-| __C declaration:__ @args_char3@ @@ -815,7 +835,7 @@ foreign import ccall unsafe "hs_bindgen_3ef14607a6187aaa" args_char2 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_char3@ -} -foreign import ccall unsafe "hs_bindgen_5b0a626f64912f9d" args_char3 :: +args_char3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -823,6 +843,13 @@ foreign import ccall unsafe "hs_bindgen_5b0a626f64912f9d" args_char3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_char3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_char3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_36e4501239085bc1" args_short1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CShort -> IO ()) {-| __C declaration:__ @args_short1@ @@ -832,7 +859,7 @@ foreign import ccall unsafe "hs_bindgen_5b0a626f64912f9d" args_char3 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_short1@ -} -foreign import ccall unsafe "hs_bindgen_36e4501239085bc1" args_short1 :: +args_short1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -840,6 +867,13 @@ foreign import ccall unsafe "hs_bindgen_36e4501239085bc1" args_short1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_short1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_short1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a187e0233daeb237" args_short2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CShort -> IO ()) {-| __C declaration:__ @args_short2@ @@ -849,7 +883,7 @@ foreign import ccall unsafe "hs_bindgen_36e4501239085bc1" args_short1 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_short2@ -} -foreign import ccall unsafe "hs_bindgen_a187e0233daeb237" args_short2 :: +args_short2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -857,6 +891,13 @@ foreign import ccall unsafe "hs_bindgen_a187e0233daeb237" args_short2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_short2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_short2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2460adeff61561ce" args_short3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUShort -> IO ()) {-| __C declaration:__ @args_short3@ @@ -866,7 +907,7 @@ foreign import ccall unsafe "hs_bindgen_a187e0233daeb237" args_short2 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_short3@ -} -foreign import ccall unsafe "hs_bindgen_2460adeff61561ce" args_short3 :: +args_short3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -874,6 +915,13 @@ foreign import ccall unsafe "hs_bindgen_2460adeff61561ce" args_short3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_short3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_short3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4f13ab06db79b7f2" args_int1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CInt -> IO ()) {-| __C declaration:__ @args_int1@ @@ -883,7 +931,7 @@ foreign import ccall unsafe "hs_bindgen_2460adeff61561ce" args_short3 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_int1@ -} -foreign import ccall unsafe "hs_bindgen_4f13ab06db79b7f2" args_int1 :: +args_int1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -891,6 +939,13 @@ foreign import ccall unsafe "hs_bindgen_4f13ab06db79b7f2" args_int1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_int1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_int1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f1657d18f6f8a1ed" args_int2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CInt -> IO ()) {-| __C declaration:__ @args_int2@ @@ -900,7 +955,7 @@ foreign import ccall unsafe "hs_bindgen_4f13ab06db79b7f2" args_int1 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_int2@ -} -foreign import ccall unsafe "hs_bindgen_f1657d18f6f8a1ed" args_int2 :: +args_int2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -908,6 +963,13 @@ foreign import ccall unsafe "hs_bindgen_f1657d18f6f8a1ed" args_int2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_int2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_int2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9ac58b8eb806be42" args_int3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUInt -> IO ()) {-| __C declaration:__ @args_int3@ @@ -917,7 +979,7 @@ foreign import ccall unsafe "hs_bindgen_f1657d18f6f8a1ed" args_int2 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_int3@ -} -foreign import ccall unsafe "hs_bindgen_9ac58b8eb806be42" args_int3 :: +args_int3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -925,6 +987,13 @@ foreign import ccall unsafe "hs_bindgen_9ac58b8eb806be42" args_int3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_int3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_int3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f73c59fe22a9870e" args_long1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CLong -> IO ()) {-| __C declaration:__ @args_long1@ @@ -934,7 +1003,7 @@ foreign import ccall unsafe "hs_bindgen_9ac58b8eb806be42" args_int3 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_long1@ -} -foreign import ccall unsafe "hs_bindgen_f73c59fe22a9870e" args_long1 :: +args_long1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -942,6 +1011,13 @@ foreign import ccall unsafe "hs_bindgen_f73c59fe22a9870e" args_long1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_long1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_long1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_84a824853fc83077" args_long2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CLong -> IO ()) {-| __C declaration:__ @args_long2@ @@ -951,7 +1027,7 @@ foreign import ccall unsafe "hs_bindgen_f73c59fe22a9870e" args_long1 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_long2@ -} -foreign import ccall unsafe "hs_bindgen_84a824853fc83077" args_long2 :: +args_long2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -959,6 +1035,13 @@ foreign import ccall unsafe "hs_bindgen_84a824853fc83077" args_long2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_long2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_long2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c4c1a08ddf9cd5bc" args_long3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CULong -> IO ()) {-| __C declaration:__ @args_long3@ @@ -968,7 +1051,7 @@ foreign import ccall unsafe "hs_bindgen_84a824853fc83077" args_long2 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_long3@ -} -foreign import ccall unsafe "hs_bindgen_c4c1a08ddf9cd5bc" args_long3 :: +args_long3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -976,6 +1059,13 @@ foreign import ccall unsafe "hs_bindgen_c4c1a08ddf9cd5bc" args_long3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_long3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_long3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_58a6b5f118525c6c" args_float_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CFloat -> IO ()) {-| __C declaration:__ @args_float@ @@ -985,7 +1075,7 @@ foreign import ccall unsafe "hs_bindgen_c4c1a08ddf9cd5bc" args_long3 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_float@ -} -foreign import ccall unsafe "hs_bindgen_58a6b5f118525c6c" args_float :: +args_float :: A {- ^ __C declaration:__ @arg1@ -} @@ -993,6 +1083,13 @@ foreign import ccall unsafe "hs_bindgen_58a6b5f118525c6c" args_float :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_float = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_float_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ffc58625c3a51d8f" args_double_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CDouble -> IO ()) {-| __C declaration:__ @args_double@ @@ -1002,7 +1099,7 @@ foreign import ccall unsafe "hs_bindgen_58a6b5f118525c6c" args_float :: __unique:__ @test_macrosreparse_Example_Unsafe_args_double@ -} -foreign import ccall unsafe "hs_bindgen_ffc58625c3a51d8f" args_double :: +args_double :: A {- ^ __C declaration:__ @arg1@ -} @@ -1010,6 +1107,13 @@ foreign import ccall unsafe "hs_bindgen_ffc58625c3a51d8f" args_double :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_double = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_double_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_51fb2da1d100c9a7" args_bool1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @args_bool1@ @@ -1019,7 +1123,7 @@ foreign import ccall unsafe "hs_bindgen_ffc58625c3a51d8f" args_double :: __unique:__ @test_macrosreparse_Example_Unsafe_args_bool1@ -} -foreign import ccall unsafe "hs_bindgen_51fb2da1d100c9a7" args_bool1 :: +args_bool1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1027,15 +1131,24 @@ foreign import ccall unsafe "hs_bindgen_51fb2da1d100c9a7" args_bool1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_bool1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_bool1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b2d19f91a7b9f7d3" args_struct_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_struct) -> IO ()) {-| Pointer-based API for 'args_struct' __unique:__ @test_macrosreparse_Example_Unsafe_args_struct@ -} -foreign import ccall unsafe "hs_bindgen_b2d19f91a7b9f7d3" args_struct_wrapper :: +args_struct_wrapper :: A -> Ptr.Ptr Some_struct -> IO () +args_struct_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_struct_wrapper_base {-| __C declaration:__ @args_struct@ @@ -1055,14 +1168,21 @@ args_struct = \x0 -> \x1 -> F.with x1 (\y2 -> args_struct_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bc74164a05d282c7" args_union_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_union) -> IO ()) + {-| Pointer-based API for 'args_union' __unique:__ @test_macrosreparse_Example_Unsafe_args_union@ -} -foreign import ccall unsafe "hs_bindgen_bc74164a05d282c7" args_union_wrapper :: +args_union_wrapper :: A -> Ptr.Ptr Some_union -> IO () +args_union_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_union_wrapper_base {-| __C declaration:__ @args_union@ @@ -1082,6 +1202,11 @@ args_union = \x0 -> \x1 -> F.with x1 (\y2 -> args_union_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_69f08c1d9f5e590e" args_enum_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> Some_enum -> IO ()) + {-| __C declaration:__ @args_enum@ __defined at:__ @macros\/reparse.h:39:6@ @@ -1090,7 +1215,7 @@ args_union = __unique:__ @test_macrosreparse_Example_Unsafe_args_enum@ -} -foreign import ccall unsafe "hs_bindgen_69f08c1d9f5e590e" args_enum :: +args_enum :: A {- ^ __C declaration:__ @arg1@ -} @@ -1098,6 +1223,13 @@ foreign import ccall unsafe "hs_bindgen_69f08c1d9f5e590e" args_enum :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_enum = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_enum_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_785b005f35d4d7ec" args_pointer1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @args_pointer1@ @@ -1107,7 +1239,7 @@ foreign import ccall unsafe "hs_bindgen_69f08c1d9f5e590e" args_enum :: __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer1@ -} -foreign import ccall unsafe "hs_bindgen_785b005f35d4d7ec" args_pointer1 :: +args_pointer1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1115,6 +1247,13 @@ foreign import ccall unsafe "hs_bindgen_785b005f35d4d7ec" args_pointer1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_pointer1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_pointer1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_edc45a1b9750dcd3" args_pointer2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Ptr.Ptr FC.CInt)) -> IO ()) {-| __C declaration:__ @args_pointer2@ @@ -1124,7 +1263,7 @@ foreign import ccall unsafe "hs_bindgen_785b005f35d4d7ec" args_pointer1 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer2@ -} -foreign import ccall unsafe "hs_bindgen_edc45a1b9750dcd3" args_pointer2 :: +args_pointer2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1132,6 +1271,13 @@ foreign import ccall unsafe "hs_bindgen_edc45a1b9750dcd3" args_pointer2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +args_pointer2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_pointer2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_102895862f35ca35" args_pointer3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Void) -> IO ()) {-| __C declaration:__ @args_pointer3@ @@ -1141,7 +1287,7 @@ foreign import ccall unsafe "hs_bindgen_edc45a1b9750dcd3" args_pointer2 :: __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer3@ -} -foreign import ccall unsafe "hs_bindgen_102895862f35ca35" args_pointer3 :: +args_pointer3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1149,6 +1295,13 @@ foreign import ccall unsafe "hs_bindgen_102895862f35ca35" args_pointer3 :: {- ^ __C declaration:__ @arg3@ -} -> IO () +args_pointer3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_pointer3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_78f9ea765accb501" ret_A_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO A) {-| __C declaration:__ @ret_A@ @@ -1158,8 +1311,15 @@ foreign import ccall unsafe "hs_bindgen_102895862f35ca35" args_pointer3 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_A@ -} -foreign import ccall unsafe "hs_bindgen_78f9ea765accb501" ret_A :: +ret_A :: IO A +ret_A = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_A_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e1e99ef9fc54a288" ret_char1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CChar) {-| __C declaration:__ @ret_char1@ @@ -1169,11 +1329,18 @@ foreign import ccall unsafe "hs_bindgen_78f9ea765accb501" ret_A :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_char1@ -} -foreign import ccall unsafe "hs_bindgen_e1e99ef9fc54a288" ret_char1 :: +ret_char1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CChar +ret_char1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_char1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f6217639a7e142d3" ret_char2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CSChar) {-| __C declaration:__ @ret_char2@ @@ -1183,11 +1350,18 @@ foreign import ccall unsafe "hs_bindgen_e1e99ef9fc54a288" ret_char1 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_char2@ -} -foreign import ccall unsafe "hs_bindgen_f6217639a7e142d3" ret_char2 :: +ret_char2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CSChar +ret_char2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_char2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_759b6cec946323f4" ret_char3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CUChar) {-| __C declaration:__ @ret_char3@ @@ -1197,11 +1371,18 @@ foreign import ccall unsafe "hs_bindgen_f6217639a7e142d3" ret_char2 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_char3@ -} -foreign import ccall unsafe "hs_bindgen_759b6cec946323f4" ret_char3 :: +ret_char3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CUChar +ret_char3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_char3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bf062c8332405f82" ret_short1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CShort) {-| __C declaration:__ @ret_short1@ @@ -1211,11 +1392,18 @@ foreign import ccall unsafe "hs_bindgen_759b6cec946323f4" ret_char3 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_short1@ -} -foreign import ccall unsafe "hs_bindgen_bf062c8332405f82" ret_short1 :: +ret_short1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CShort +ret_short1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_short1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3d9d5e4b8135169a" ret_short2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CShort) {-| __C declaration:__ @ret_short2@ @@ -1225,11 +1413,18 @@ foreign import ccall unsafe "hs_bindgen_bf062c8332405f82" ret_short1 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_short2@ -} -foreign import ccall unsafe "hs_bindgen_3d9d5e4b8135169a" ret_short2 :: +ret_short2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CShort +ret_short2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_short2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_63b44610868e424f" ret_short3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CUShort) {-| __C declaration:__ @ret_short3@ @@ -1239,11 +1434,18 @@ foreign import ccall unsafe "hs_bindgen_3d9d5e4b8135169a" ret_short2 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_short3@ -} -foreign import ccall unsafe "hs_bindgen_63b44610868e424f" ret_short3 :: +ret_short3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CUShort +ret_short3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_short3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1a8d68c887085fbf" ret_int1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CInt) {-| __C declaration:__ @ret_int1@ @@ -1253,11 +1455,18 @@ foreign import ccall unsafe "hs_bindgen_63b44610868e424f" ret_short3 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_int1@ -} -foreign import ccall unsafe "hs_bindgen_1a8d68c887085fbf" ret_int1 :: +ret_int1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CInt +ret_int1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_int1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f64653c7b4576075" ret_int2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CInt) {-| __C declaration:__ @ret_int2@ @@ -1267,11 +1476,18 @@ foreign import ccall unsafe "hs_bindgen_1a8d68c887085fbf" ret_int1 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_int2@ -} -foreign import ccall unsafe "hs_bindgen_f64653c7b4576075" ret_int2 :: +ret_int2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CInt +ret_int2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_int2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d2030910b711f1d8" ret_int3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CUInt) {-| __C declaration:__ @ret_int3@ @@ -1281,11 +1497,18 @@ foreign import ccall unsafe "hs_bindgen_f64653c7b4576075" ret_int2 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_int3@ -} -foreign import ccall unsafe "hs_bindgen_d2030910b711f1d8" ret_int3 :: +ret_int3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CUInt +ret_int3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_int3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2d6a30810e6b27e3" ret_long1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CLong) {-| __C declaration:__ @ret_long1@ @@ -1295,11 +1518,18 @@ foreign import ccall unsafe "hs_bindgen_d2030910b711f1d8" ret_int3 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_long1@ -} -foreign import ccall unsafe "hs_bindgen_2d6a30810e6b27e3" ret_long1 :: +ret_long1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CLong +ret_long1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_long1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_02885fe1cf2771da" ret_long2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CLong) {-| __C declaration:__ @ret_long2@ @@ -1309,11 +1539,18 @@ foreign import ccall unsafe "hs_bindgen_2d6a30810e6b27e3" ret_long1 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_long2@ -} -foreign import ccall unsafe "hs_bindgen_02885fe1cf2771da" ret_long2 :: +ret_long2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CLong +ret_long2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_long2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_888c9704132541d5" ret_long3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CULong) {-| __C declaration:__ @ret_long3@ @@ -1323,11 +1560,18 @@ foreign import ccall unsafe "hs_bindgen_02885fe1cf2771da" ret_long2 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_long3@ -} -foreign import ccall unsafe "hs_bindgen_888c9704132541d5" ret_long3 :: +ret_long3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CULong +ret_long3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_long3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2d2ce0d386f26293" ret_float_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CFloat) {-| __C declaration:__ @ret_float@ @@ -1337,11 +1581,18 @@ foreign import ccall unsafe "hs_bindgen_888c9704132541d5" ret_long3 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_float@ -} -foreign import ccall unsafe "hs_bindgen_2d2ce0d386f26293" ret_float :: +ret_float :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CFloat +ret_float = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_float_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_de353a737de53428" ret_double_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CDouble) {-| __C declaration:__ @ret_double@ @@ -1351,11 +1602,18 @@ foreign import ccall unsafe "hs_bindgen_2d2ce0d386f26293" ret_float :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_double@ -} -foreign import ccall unsafe "hs_bindgen_de353a737de53428" ret_double :: +ret_double :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CDouble +ret_double = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_double_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_91e2ab77e68f0288" ret_bool1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CBool) {-| __C declaration:__ @ret_bool1@ @@ -1365,20 +1623,29 @@ foreign import ccall unsafe "hs_bindgen_de353a737de53428" ret_double :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_bool1@ -} -foreign import ccall unsafe "hs_bindgen_91e2ab77e68f0288" ret_bool1 :: +ret_bool1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CBool +ret_bool1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_bool1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9f29c7eee02f6d53" ret_struct_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_struct) -> IO ()) {-| Pointer-based API for 'ret_struct' __unique:__ @test_macrosreparse_Example_Unsafe_ret_struct@ -} -foreign import ccall unsafe "hs_bindgen_9f29c7eee02f6d53" ret_struct_wrapper :: +ret_struct_wrapper :: A -> Ptr.Ptr Some_struct -> IO () +ret_struct_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_struct_wrapper_base {-| __C declaration:__ @ret_struct@ @@ -1396,14 +1663,21 @@ ret_struct = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> ret_struct_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6844bf5f5a5f6681" ret_union_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_union) -> IO ()) + {-| Pointer-based API for 'ret_union' __unique:__ @test_macrosreparse_Example_Unsafe_ret_union@ -} -foreign import ccall unsafe "hs_bindgen_6844bf5f5a5f6681" ret_union_wrapper :: +ret_union_wrapper :: A -> Ptr.Ptr Some_union -> IO () +ret_union_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_union_wrapper_base {-| __C declaration:__ @ret_union@ @@ -1421,6 +1695,11 @@ ret_union = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> ret_union_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f96c4bc30b6b17e8" ret_enum_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO Some_enum) + {-| __C declaration:__ @ret_enum@ __defined at:__ @macros\/reparse.h:71:20@ @@ -1429,11 +1708,18 @@ ret_union = __unique:__ @test_macrosreparse_Example_Unsafe_ret_enum@ -} -foreign import ccall unsafe "hs_bindgen_f96c4bc30b6b17e8" ret_enum :: +ret_enum :: A {- ^ __C declaration:__ @arg1@ -} -> IO Some_enum +ret_enum = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_enum_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bfb6069e1423e7a5" ret_pointer1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @ret_pointer1@ @@ -1443,11 +1729,18 @@ foreign import ccall unsafe "hs_bindgen_f96c4bc30b6b17e8" ret_enum :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer1@ -} -foreign import ccall unsafe "hs_bindgen_bfb6069e1423e7a5" ret_pointer1 :: +ret_pointer1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +ret_pointer1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_pointer1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ffae633548386d89" ret_pointer2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) {-| __C declaration:__ @ret_pointer2@ @@ -1457,11 +1750,18 @@ foreign import ccall unsafe "hs_bindgen_bfb6069e1423e7a5" ret_pointer1 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer2@ -} -foreign import ccall unsafe "hs_bindgen_ffae633548386d89" ret_pointer2 :: +ret_pointer2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr (Ptr.Ptr FC.CInt)) +ret_pointer2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_pointer2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_550cb4a23c6ab2ff" ret_pointer3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr Void)) {-| __C declaration:__ @ret_pointer3@ @@ -1471,11 +1771,18 @@ foreign import ccall unsafe "hs_bindgen_ffae633548386d89" ret_pointer2 :: __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer3@ -} -foreign import ccall unsafe "hs_bindgen_550cb4a23c6ab2ff" ret_pointer3 :: +ret_pointer3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr Void) +ret_pointer3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_pointer3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f7a7a45a80ae39f7" body1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CInt) {-| __C declaration:__ @body1@ @@ -1485,11 +1792,18 @@ foreign import ccall unsafe "hs_bindgen_550cb4a23c6ab2ff" ret_pointer3 :: __unique:__ @test_macrosreparse_Example_Unsafe_body1@ -} -foreign import ccall unsafe "hs_bindgen_f7a7a45a80ae39f7" body1 :: +body1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CInt +body1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType body1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_364e73b014d7d4df" body2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO A) {-| __C declaration:__ @body2@ @@ -1499,17 +1813,26 @@ foreign import ccall unsafe "hs_bindgen_f7a7a45a80ae39f7" body1 :: __unique:__ @test_macrosreparse_Example_Unsafe_body2@ -} -foreign import ccall unsafe "hs_bindgen_364e73b014d7d4df" body2 :: +body2 :: IO A +body2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType body2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_88b4cd11afc4f6c1" args_complex_float_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> IO ()) {-| Pointer-based API for 'args_complex_float' __unique:__ @test_macrosreparse_Example_Unsafe_args_complex_float@ -} -foreign import ccall unsafe "hs_bindgen_88b4cd11afc4f6c1" args_complex_float_wrapper :: +args_complex_float_wrapper :: A -> Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> IO () +args_complex_float_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_complex_float_wrapper_base {-| __C declaration:__ @args_complex_float@ @@ -1530,14 +1853,21 @@ args_complex_float = \x1 -> F.with x1 (\y2 -> args_complex_float_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0ddc53d8e91cb32a" args_complex_double_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> IO ()) + {-| Pointer-based API for 'args_complex_double' __unique:__ @test_macrosreparse_Example_Unsafe_args_complex_double@ -} -foreign import ccall unsafe "hs_bindgen_0ddc53d8e91cb32a" args_complex_double_wrapper :: +args_complex_double_wrapper :: A -> Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> IO () +args_complex_double_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType args_complex_double_wrapper_base {-| __C declaration:__ @args_complex_double@ @@ -1558,14 +1888,21 @@ args_complex_double = \x1 -> F.with x1 (\y2 -> args_complex_double_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_eb82eb840e288900" ret_complex_float_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> IO ()) + {-| Pointer-based API for 'ret_complex_float' __unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_float@ -} -foreign import ccall unsafe "hs_bindgen_eb82eb840e288900" ret_complex_float_wrapper :: +ret_complex_float_wrapper :: A -> Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> IO () +ret_complex_float_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_complex_float_wrapper_base {-| __C declaration:__ @ret_complex_float@ @@ -1583,14 +1920,21 @@ ret_complex_float = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> ret_complex_float_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cbc25ea9cbdd2365" ret_complex_double_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> IO ()) + {-| Pointer-based API for 'ret_complex_double' __unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_double@ -} -foreign import ccall unsafe "hs_bindgen_cbc25ea9cbdd2365" ret_complex_double_wrapper :: +ret_complex_double_wrapper :: A -> Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> IO () +ret_complex_double_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType ret_complex_double_wrapper_base {-| __C declaration:__ @ret_complex_double@ @@ -1608,6 +1952,11 @@ ret_complex_double = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> ret_complex_double_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3258de4ffd2c08af" bespoke_args1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) + {-| __C declaration:__ @bespoke_args1@ __defined at:__ @macros\/reparse.h:94:6@ @@ -1616,7 +1965,7 @@ ret_complex_double = __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args1@ -} -foreign import ccall unsafe "hs_bindgen_3258de4ffd2c08af" bespoke_args1 :: +bespoke_args1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1624,6 +1973,13 @@ foreign import ccall unsafe "hs_bindgen_3258de4ffd2c08af" bespoke_args1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +bespoke_args1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bespoke_args1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_74b2cd1defdd5609" bespoke_args2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()) {-| __C declaration:__ @bespoke_args2@ @@ -1633,7 +1989,7 @@ foreign import ccall unsafe "hs_bindgen_3258de4ffd2c08af" bespoke_args1 :: __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args2@ -} -foreign import ccall unsafe "hs_bindgen_74b2cd1defdd5609" bespoke_args2 :: +bespoke_args2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1641,6 +1997,13 @@ foreign import ccall unsafe "hs_bindgen_74b2cd1defdd5609" bespoke_args2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +bespoke_args2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bespoke_args2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5405c1e037d1e115" bespoke_ret1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO FC.CBool) {-| __C declaration:__ @bespoke_ret1@ @@ -1650,11 +2013,18 @@ foreign import ccall unsafe "hs_bindgen_74b2cd1defdd5609" bespoke_args2 :: __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret1@ -} -foreign import ccall unsafe "hs_bindgen_5405c1e037d1e115" bespoke_ret1 :: +bespoke_ret1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO FC.CBool +bespoke_ret1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bespoke_ret1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a6a3e5a828532360" bespoke_ret2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO HsBindgen.Runtime.Prelude.CSize) {-| __C declaration:__ @bespoke_ret2@ @@ -1664,11 +2034,18 @@ foreign import ccall unsafe "hs_bindgen_5405c1e037d1e115" bespoke_ret1 :: __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret2@ -} -foreign import ccall unsafe "hs_bindgen_a6a3e5a828532360" bespoke_ret2 :: +bespoke_ret2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO HsBindgen.Runtime.Prelude.CSize +bespoke_ret2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType bespoke_ret2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4956a52bf5073b9f" arr_args1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr A) -> IO ()) {-| Arrays @@ -1680,11 +2057,18 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_arr_args1@ -} -foreign import ccall unsafe "hs_bindgen_4956a52bf5073b9f" arr_args1 :: +arr_args1 :: Ptr.Ptr A {- ^ __C declaration:__ @arg1@ -} -> IO () +arr_args1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType arr_args1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0fc8b091085a88e9" arr_args2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr A)) -> IO ()) {-| __C declaration:__ @arr_args2@ @@ -1694,11 +2078,18 @@ foreign import ccall unsafe "hs_bindgen_4956a52bf5073b9f" arr_args1 :: __unique:__ @test_macrosreparse_Example_Unsafe_arr_args2@ -} -foreign import ccall unsafe "hs_bindgen_0fc8b091085a88e9" arr_args2 :: +arr_args2 :: Ptr.Ptr (Ptr.Ptr A) {- ^ __C declaration:__ @arg1@ -} -> IO () +arr_args2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType arr_args2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ca6f1bc1a29b85f8" arr_args3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr A) -> IO ()) {-| __C declaration:__ @arr_args3@ @@ -1708,11 +2099,18 @@ foreign import ccall unsafe "hs_bindgen_0fc8b091085a88e9" arr_args2 :: __unique:__ @test_macrosreparse_Example_Unsafe_arr_args3@ -} -foreign import ccall unsafe "hs_bindgen_ca6f1bc1a29b85f8" arr_args3 :: +arr_args3 :: Ptr.Ptr A {- ^ __C declaration:__ @arg1@ -} -> IO () +arr_args3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType arr_args3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a168ae0de206febe" arr_args4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr A)) -> IO ()) {-| __C declaration:__ @arr_args4@ @@ -1722,11 +2120,18 @@ foreign import ccall unsafe "hs_bindgen_ca6f1bc1a29b85f8" arr_args3 :: __unique:__ @test_macrosreparse_Example_Unsafe_arr_args4@ -} -foreign import ccall unsafe "hs_bindgen_a168ae0de206febe" arr_args4 :: +arr_args4 :: Ptr.Ptr (Ptr.Ptr A) {- ^ __C declaration:__ @arg1@ -} -> IO () +arr_args4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType arr_args4_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8e63f57f1f5d662e" funptr_args1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (IO ())) -> IO ()) {-| Function pointers @@ -1738,7 +2143,7 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args1@ -} -foreign import ccall unsafe "hs_bindgen_8e63f57f1f5d662e" funptr_args1 :: +funptr_args1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1746,6 +2151,13 @@ foreign import ccall unsafe "hs_bindgen_8e63f57f1f5d662e" funptr_args1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_927bd07f48d05d21" funptr_args2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ()) {-| __C declaration:__ @funptr_args2@ @@ -1755,7 +2167,7 @@ foreign import ccall unsafe "hs_bindgen_8e63f57f1f5d662e" funptr_args1 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args2@ -} -foreign import ccall unsafe "hs_bindgen_927bd07f48d05d21" funptr_args2 :: +funptr_args2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1763,6 +2175,13 @@ foreign import ccall unsafe "hs_bindgen_927bd07f48d05d21" funptr_args2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c82e078d3c54a6bc" funptr_args3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (FC.CInt -> IO ())) -> IO ()) {-| __C declaration:__ @funptr_args3@ @@ -1772,7 +2191,7 @@ foreign import ccall unsafe "hs_bindgen_927bd07f48d05d21" funptr_args2 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args3@ -} -foreign import ccall unsafe "hs_bindgen_c82e078d3c54a6bc" funptr_args3 :: +funptr_args3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1780,6 +2199,13 @@ foreign import ccall unsafe "hs_bindgen_c82e078d3c54a6bc" funptr_args3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_211ad1ac5399caec" funptr_args4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar)) -> IO ()) {-| __C declaration:__ @funptr_args4@ @@ -1789,7 +2215,7 @@ foreign import ccall unsafe "hs_bindgen_c82e078d3c54a6bc" funptr_args3 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args4@ -} -foreign import ccall unsafe "hs_bindgen_211ad1ac5399caec" funptr_args4 :: +funptr_args4 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1797,6 +2223,13 @@ foreign import ccall unsafe "hs_bindgen_211ad1ac5399caec" funptr_args4 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args4_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9057c59d70e815d7" funptr_args5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) -> IO ()) {-| __C declaration:__ @funptr_args5@ @@ -1806,7 +2239,7 @@ foreign import ccall unsafe "hs_bindgen_211ad1ac5399caec" funptr_args4 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args5@ -} -foreign import ccall unsafe "hs_bindgen_9057c59d70e815d7" funptr_args5 :: +funptr_args5 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1814,6 +2247,13 @@ foreign import ccall unsafe "hs_bindgen_9057c59d70e815d7" funptr_args5 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +funptr_args5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_args5_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_153515e0ff74574f" comments1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO ()) {-| Comments in awkward places @@ -1827,11 +2267,18 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_comments1@ -} -foreign import ccall unsafe "hs_bindgen_153515e0ff74574f" comments1 :: +comments1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO () +comments1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType comments1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8cc833db463cc95c" const_prim_before1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CChar -> IO ()) {-| `const` qualifier @@ -1845,7 +2292,7 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before1@ -} -foreign import ccall unsafe "hs_bindgen_8cc833db463cc95c" const_prim_before1 :: +const_prim_before1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1853,6 +2300,13 @@ foreign import ccall unsafe "hs_bindgen_8cc833db463cc95c" const_prim_before1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_before1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_before1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d767bbef00031d57" const_prim_before2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CSChar -> IO ()) {-| __C declaration:__ @const_prim_before2@ @@ -1862,7 +2316,7 @@ foreign import ccall unsafe "hs_bindgen_8cc833db463cc95c" const_prim_before1 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before2@ -} -foreign import ccall unsafe "hs_bindgen_d767bbef00031d57" const_prim_before2 :: +const_prim_before2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1870,6 +2324,13 @@ foreign import ccall unsafe "hs_bindgen_d767bbef00031d57" const_prim_before2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_before2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_before2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a36dfeb811993297" const_prim_before3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUChar -> IO ()) {-| __C declaration:__ @const_prim_before3@ @@ -1879,7 +2340,7 @@ foreign import ccall unsafe "hs_bindgen_d767bbef00031d57" const_prim_before2 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before3@ -} -foreign import ccall unsafe "hs_bindgen_a36dfeb811993297" const_prim_before3 :: +const_prim_before3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1887,6 +2348,13 @@ foreign import ccall unsafe "hs_bindgen_a36dfeb811993297" const_prim_before3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_before3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_before3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d7fa2440be24e954" const_prim_after1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CChar -> IO ()) {-| __C declaration:__ @const_prim_after1@ @@ -1896,7 +2364,7 @@ foreign import ccall unsafe "hs_bindgen_a36dfeb811993297" const_prim_before3 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after1@ -} -foreign import ccall unsafe "hs_bindgen_d7fa2440be24e954" const_prim_after1 :: +const_prim_after1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1904,6 +2372,13 @@ foreign import ccall unsafe "hs_bindgen_d7fa2440be24e954" const_prim_after1 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_after1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_after1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c169229f24baf752" const_prim_after2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CSChar -> IO ()) {-| __C declaration:__ @const_prim_after2@ @@ -1913,7 +2388,7 @@ foreign import ccall unsafe "hs_bindgen_d7fa2440be24e954" const_prim_after1 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after2@ -} -foreign import ccall unsafe "hs_bindgen_c169229f24baf752" const_prim_after2 :: +const_prim_after2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1921,6 +2396,13 @@ foreign import ccall unsafe "hs_bindgen_c169229f24baf752" const_prim_after2 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_after2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_after2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c0780f7624ed1d3e" const_prim_after3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CUChar -> IO ()) {-| __C declaration:__ @const_prim_after3@ @@ -1930,7 +2412,7 @@ foreign import ccall unsafe "hs_bindgen_c169229f24baf752" const_prim_after2 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after3@ -} -foreign import ccall unsafe "hs_bindgen_c0780f7624ed1d3e" const_prim_after3 :: +const_prim_after3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1938,6 +2420,13 @@ foreign import ccall unsafe "hs_bindgen_c0780f7624ed1d3e" const_prim_after3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +const_prim_after3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_prim_after3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fda903bc1139b1d6" const_withoutSign_before1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CFloat -> IO ()) {-| __C declaration:__ @const_withoutSign_before1@ @@ -1947,7 +2436,7 @@ foreign import ccall unsafe "hs_bindgen_c0780f7624ed1d3e" const_prim_after3 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before1@ -} -foreign import ccall unsafe "hs_bindgen_fda903bc1139b1d6" const_withoutSign_before1 :: +const_withoutSign_before1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1955,6 +2444,13 @@ foreign import ccall unsafe "hs_bindgen_fda903bc1139b1d6" const_withoutSign_befo {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a5a70f3be654ea00" const_withoutSign_before2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CDouble -> IO ()) {-| __C declaration:__ @const_withoutSign_before2@ @@ -1964,7 +2460,7 @@ foreign import ccall unsafe "hs_bindgen_fda903bc1139b1d6" const_withoutSign_befo __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before2@ -} -foreign import ccall unsafe "hs_bindgen_a5a70f3be654ea00" const_withoutSign_before2 :: +const_withoutSign_before2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1972,6 +2468,13 @@ foreign import ccall unsafe "hs_bindgen_a5a70f3be654ea00" const_withoutSign_befo {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b813910f6a632ce2" const_withoutSign_before3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @const_withoutSign_before3@ @@ -1981,7 +2484,7 @@ foreign import ccall unsafe "hs_bindgen_a5a70f3be654ea00" const_withoutSign_befo __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before3@ -} -foreign import ccall unsafe "hs_bindgen_b813910f6a632ce2" const_withoutSign_before3 :: +const_withoutSign_before3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -1989,15 +2492,24 @@ foreign import ccall unsafe "hs_bindgen_b813910f6a632ce2" const_withoutSign_befo {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_dc22b02b2f53aa5b" const_withoutSign_before4_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_struct) -> IO ()) {-| Pointer-based API for 'const_withoutSign_before4' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before4@ -} -foreign import ccall unsafe "hs_bindgen_dc22b02b2f53aa5b" const_withoutSign_before4_wrapper :: +const_withoutSign_before4_wrapper :: A -> Ptr.Ptr Some_struct -> IO () +const_withoutSign_before4_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before4_wrapper_base {-| __C declaration:__ @const_withoutSign_before4@ @@ -2019,14 +2531,21 @@ const_withoutSign_before4 = F.with x1 (\y2 -> const_withoutSign_before4_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_503736261279760d" const_withoutSign_before5_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_union) -> IO ()) + {-| Pointer-based API for 'const_withoutSign_before5' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before5@ -} -foreign import ccall unsafe "hs_bindgen_503736261279760d" const_withoutSign_before5_wrapper :: +const_withoutSign_before5_wrapper :: A -> Ptr.Ptr Some_union -> IO () +const_withoutSign_before5_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before5_wrapper_base {-| __C declaration:__ @const_withoutSign_before5@ @@ -2048,6 +2567,11 @@ const_withoutSign_before5 = F.with x1 (\y2 -> const_withoutSign_before5_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ed0a8c0e15f5d2ce" const_withoutSign_before6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> Some_enum -> IO ()) + {-| __C declaration:__ @const_withoutSign_before6@ __defined at:__ @macros\/reparse.h:193:6@ @@ -2056,7 +2580,7 @@ const_withoutSign_before5 = __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before6@ -} -foreign import ccall unsafe "hs_bindgen_ed0a8c0e15f5d2ce" const_withoutSign_before6 :: +const_withoutSign_before6 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2064,6 +2588,13 @@ foreign import ccall unsafe "hs_bindgen_ed0a8c0e15f5d2ce" const_withoutSign_befo {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before6_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4659c22d39cc1bb3" const_withoutSign_before7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @const_withoutSign_before7@ @@ -2073,7 +2604,7 @@ foreign import ccall unsafe "hs_bindgen_ed0a8c0e15f5d2ce" const_withoutSign_befo __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before7@ -} -foreign import ccall unsafe "hs_bindgen_4659c22d39cc1bb3" const_withoutSign_before7 :: +const_withoutSign_before7 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2081,6 +2612,13 @@ foreign import ccall unsafe "hs_bindgen_4659c22d39cc1bb3" const_withoutSign_befo {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before7_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_530245b77093b08c" const_withoutSign_before8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()) {-| __C declaration:__ @const_withoutSign_before8@ @@ -2090,7 +2628,7 @@ foreign import ccall unsafe "hs_bindgen_4659c22d39cc1bb3" const_withoutSign_befo __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before8@ -} -foreign import ccall unsafe "hs_bindgen_530245b77093b08c" const_withoutSign_before8 :: +const_withoutSign_before8 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2098,6 +2636,13 @@ foreign import ccall unsafe "hs_bindgen_530245b77093b08c" const_withoutSign_befo {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_before8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_before8_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c31a804bd742193e" const_withoutSign_after1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CFloat -> IO ()) {-| __C declaration:__ @const_withoutSign_after1@ @@ -2107,7 +2652,7 @@ foreign import ccall unsafe "hs_bindgen_530245b77093b08c" const_withoutSign_befo __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after1@ -} -foreign import ccall unsafe "hs_bindgen_c31a804bd742193e" const_withoutSign_after1 :: +const_withoutSign_after1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2115,6 +2660,13 @@ foreign import ccall unsafe "hs_bindgen_c31a804bd742193e" const_withoutSign_afte {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_53756fa3a68ab067" const_withoutSign_after2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CDouble -> IO ()) {-| __C declaration:__ @const_withoutSign_after2@ @@ -2124,7 +2676,7 @@ foreign import ccall unsafe "hs_bindgen_c31a804bd742193e" const_withoutSign_afte __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after2@ -} -foreign import ccall unsafe "hs_bindgen_53756fa3a68ab067" const_withoutSign_after2 :: +const_withoutSign_after2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2132,6 +2684,13 @@ foreign import ccall unsafe "hs_bindgen_53756fa3a68ab067" const_withoutSign_afte {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4134ad71149d6139" const_withoutSign_after3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @const_withoutSign_after3@ @@ -2141,7 +2700,7 @@ foreign import ccall unsafe "hs_bindgen_53756fa3a68ab067" const_withoutSign_afte __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after3@ -} -foreign import ccall unsafe "hs_bindgen_4134ad71149d6139" const_withoutSign_after3 :: +const_withoutSign_after3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2149,15 +2708,24 @@ foreign import ccall unsafe "hs_bindgen_4134ad71149d6139" const_withoutSign_afte {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3de6157427334101" const_withoutSign_after4_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_struct) -> IO ()) {-| Pointer-based API for 'const_withoutSign_after4' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after4@ -} -foreign import ccall unsafe "hs_bindgen_3de6157427334101" const_withoutSign_after4_wrapper :: +const_withoutSign_after4_wrapper :: A -> Ptr.Ptr Some_struct -> IO () +const_withoutSign_after4_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after4_wrapper_base {-| __C declaration:__ @const_withoutSign_after4@ @@ -2179,14 +2747,21 @@ const_withoutSign_after4 = F.with x1 (\y2 -> const_withoutSign_after4_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_fc4ef8c9107c1ae6" const_withoutSign_after5_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr Some_union) -> IO ()) + {-| Pointer-based API for 'const_withoutSign_after5' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after5@ -} -foreign import ccall unsafe "hs_bindgen_fc4ef8c9107c1ae6" const_withoutSign_after5_wrapper :: +const_withoutSign_after5_wrapper :: A -> Ptr.Ptr Some_union -> IO () +const_withoutSign_after5_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after5_wrapper_base {-| __C declaration:__ @const_withoutSign_after5@ @@ -2208,6 +2783,11 @@ const_withoutSign_after5 = F.with x1 (\y2 -> const_withoutSign_after5_wrapper x0 y2) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5e20c60b725ae606" const_withoutSign_after6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> Some_enum -> IO ()) + {-| __C declaration:__ @const_withoutSign_after6@ __defined at:__ @macros\/reparse.h:202:6@ @@ -2216,7 +2796,7 @@ const_withoutSign_after5 = __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after6@ -} -foreign import ccall unsafe "hs_bindgen_5e20c60b725ae606" const_withoutSign_after6 :: +const_withoutSign_after6 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2224,6 +2804,13 @@ foreign import ccall unsafe "hs_bindgen_5e20c60b725ae606" const_withoutSign_afte {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after6_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a0f20d4b9a07ff5b" const_withoutSign_after7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> FC.CBool -> IO ()) {-| __C declaration:__ @const_withoutSign_after7@ @@ -2233,7 +2820,7 @@ foreign import ccall unsafe "hs_bindgen_5e20c60b725ae606" const_withoutSign_afte __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after7@ -} -foreign import ccall unsafe "hs_bindgen_a0f20d4b9a07ff5b" const_withoutSign_after7 :: +const_withoutSign_after7 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2241,6 +2828,13 @@ foreign import ccall unsafe "hs_bindgen_a0f20d4b9a07ff5b" const_withoutSign_afte {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after7_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3a020035eb2fe7f8" const_withoutSign_after8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> HsBindgen.Runtime.Prelude.CSize -> IO ()) {-| __C declaration:__ @const_withoutSign_after8@ @@ -2250,7 +2844,7 @@ foreign import ccall unsafe "hs_bindgen_a0f20d4b9a07ff5b" const_withoutSign_afte __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after8@ -} -foreign import ccall unsafe "hs_bindgen_3a020035eb2fe7f8" const_withoutSign_after8 :: +const_withoutSign_after8 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2258,6 +2852,13 @@ foreign import ccall unsafe "hs_bindgen_3a020035eb2fe7f8" const_withoutSign_afte {- ^ __C declaration:__ @arg2@ -} -> IO () +const_withoutSign_after8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_withoutSign_after8_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_17623ba5065bf95d" const_pointers_args1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args1@ @@ -2267,7 +2868,7 @@ foreign import ccall unsafe "hs_bindgen_3a020035eb2fe7f8" const_withoutSign_afte __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args1@ -} -foreign import ccall unsafe "hs_bindgen_17623ba5065bf95d" const_pointers_args1 :: +const_pointers_args1 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2275,6 +2876,13 @@ foreign import ccall unsafe "hs_bindgen_17623ba5065bf95d" const_pointers_args1 : {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_02d08ccd5df88a98" const_pointers_args2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args2@ @@ -2284,7 +2892,7 @@ foreign import ccall unsafe "hs_bindgen_17623ba5065bf95d" const_pointers_args1 : __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args2@ -} -foreign import ccall unsafe "hs_bindgen_02d08ccd5df88a98" const_pointers_args2 :: +const_pointers_args2 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2292,6 +2900,13 @@ foreign import ccall unsafe "hs_bindgen_02d08ccd5df88a98" const_pointers_args2 : {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_50c423f2237cb6b5" const_pointers_args3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args3@ @@ -2301,7 +2916,7 @@ foreign import ccall unsafe "hs_bindgen_02d08ccd5df88a98" const_pointers_args2 : __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args3@ -} -foreign import ccall unsafe "hs_bindgen_50c423f2237cb6b5" const_pointers_args3 :: +const_pointers_args3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2309,6 +2924,13 @@ foreign import ccall unsafe "hs_bindgen_50c423f2237cb6b5" const_pointers_args3 : {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_99c29c45d78348e9" const_pointers_args4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args4@ @@ -2318,7 +2940,7 @@ foreign import ccall unsafe "hs_bindgen_50c423f2237cb6b5" const_pointers_args3 : __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args4@ -} -foreign import ccall unsafe "hs_bindgen_99c29c45d78348e9" const_pointers_args4 :: +const_pointers_args4 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2326,6 +2948,13 @@ foreign import ccall unsafe "hs_bindgen_99c29c45d78348e9" const_pointers_args4 : {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args4_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6a92dbfae24b1bcd" const_pointers_args5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.Ptr FC.CInt) -> IO ()) {-| __C declaration:__ @const_pointers_args5@ @@ -2335,7 +2964,7 @@ foreign import ccall unsafe "hs_bindgen_99c29c45d78348e9" const_pointers_args4 : __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args5@ -} -foreign import ccall unsafe "hs_bindgen_6a92dbfae24b1bcd" const_pointers_args5 :: +const_pointers_args5 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2343,6 +2972,13 @@ foreign import ccall unsafe "hs_bindgen_6a92dbfae24b1bcd" const_pointers_args5 : {- ^ __C declaration:__ @arg2@ -} -> IO () +const_pointers_args5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_args5_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0c07f1e0256fd705" const_pointers_ret1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret1@ @@ -2352,11 +2988,18 @@ foreign import ccall unsafe "hs_bindgen_6a92dbfae24b1bcd" const_pointers_args5 : __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret1@ -} -foreign import ccall unsafe "hs_bindgen_0c07f1e0256fd705" const_pointers_ret1 :: +const_pointers_ret1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d12c8210ff3c3711" const_pointers_ret2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret2@ @@ -2366,11 +3009,18 @@ foreign import ccall unsafe "hs_bindgen_0c07f1e0256fd705" const_pointers_ret1 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret2@ -} -foreign import ccall unsafe "hs_bindgen_d12c8210ff3c3711" const_pointers_ret2 :: +const_pointers_ret2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a58bc0be6f564801" const_pointers_ret3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret3@ @@ -2380,11 +3030,18 @@ foreign import ccall unsafe "hs_bindgen_d12c8210ff3c3711" const_pointers_ret2 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret3@ -} -foreign import ccall unsafe "hs_bindgen_a58bc0be6f564801" const_pointers_ret3 :: +const_pointers_ret3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_622bb8150470138b" const_pointers_ret4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret4@ @@ -2394,11 +3051,18 @@ foreign import ccall unsafe "hs_bindgen_a58bc0be6f564801" const_pointers_ret3 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret4@ -} -foreign import ccall unsafe "hs_bindgen_622bb8150470138b" const_pointers_ret4 :: +const_pointers_ret4 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret4_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d49bd331ad2077e5" const_pointers_ret5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.Ptr FC.CInt)) {-| __C declaration:__ @const_pointers_ret5@ @@ -2408,19 +3072,28 @@ foreign import ccall unsafe "hs_bindgen_622bb8150470138b" const_pointers_ret4 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret5@ -} -foreign import ccall unsafe "hs_bindgen_d49bd331ad2077e5" const_pointers_ret5 :: +const_pointers_ret5 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.Ptr FC.CInt) +const_pointers_ret5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_pointers_ret5_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_224608f780bff5bd" const_array_elem1_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr A) -> IO ()) {-| Pointer-based API for 'const_array_elem1' __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem1@ -} -foreign import ccall unsafe "hs_bindgen_224608f780bff5bd" const_array_elem1_wrapper :: +const_array_elem1_wrapper :: Ptr.Ptr A -> IO () +const_array_elem1_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_array_elem1_wrapper_base {-| __C declaration:__ @const_array_elem1@ @@ -2438,6 +3111,11 @@ const_array_elem1 = HsBindgen.Runtime.IncompleteArray.withPtr x0 (\ptr1 -> const_array_elem1_wrapper ptr1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9aa74ad89f2c1fba" const_array_elem2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr A)) -> IO ()) + {-| __C declaration:__ @const_array_elem2@ __defined at:__ @macros\/reparse.h:247:6@ @@ -2446,19 +3124,28 @@ const_array_elem1 = __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem2@ -} -foreign import ccall unsafe "hs_bindgen_9aa74ad89f2c1fba" const_array_elem2 :: +const_array_elem2 :: Ptr.Ptr (Ptr.Ptr A) {- ^ __C declaration:__ @arg1@ -} -> IO () +const_array_elem2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_array_elem2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6a328300c5ef0c9e" const_array_elem3_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr A)) -> IO ()) {-| Pointer-based API for 'const_array_elem3' __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem3@ -} -foreign import ccall unsafe "hs_bindgen_6a328300c5ef0c9e" const_array_elem3_wrapper :: +const_array_elem3_wrapper :: Ptr.Ptr (Ptr.Ptr A) -> IO () +const_array_elem3_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType const_array_elem3_wrapper_base {-| __C declaration:__ @const_array_elem3@ @@ -2476,6 +3163,11 @@ const_array_elem3 = HsBindgen.Runtime.IncompleteArray.withPtr x0 (\ptr1 -> const_array_elem3_wrapper ptr1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_13a7d78e11555d58" noParams1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO A) + {-| Other examples we reparsed /incorrectly/ before language-c __C declaration:__ @noParams1@ @@ -2486,8 +3178,15 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_noParams1@ -} -foreign import ccall unsafe "hs_bindgen_13a7d78e11555d58" noParams1 :: +noParams1 :: IO A +noParams1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType noParams1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_672f4691ee7a367c" noParams2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO A) {-| __C declaration:__ @noParams2@ @@ -2497,8 +3196,15 @@ foreign import ccall unsafe "hs_bindgen_13a7d78e11555d58" noParams1 :: __unique:__ @test_macrosreparse_Example_Unsafe_noParams2@ -} -foreign import ccall unsafe "hs_bindgen_672f4691ee7a367c" noParams2 :: +noParams2 :: IO A +noParams2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType noParams2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_591f84e2163a5d18" noParams3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> (Ptr.FunPtr (IO FC.CInt)) -> IO ()) {-| __C declaration:__ @noParams3@ @@ -2508,7 +3214,7 @@ foreign import ccall unsafe "hs_bindgen_672f4691ee7a367c" noParams2 :: __unique:__ @test_macrosreparse_Example_Unsafe_noParams3@ -} -foreign import ccall unsafe "hs_bindgen_591f84e2163a5d18" noParams3 :: +noParams3 :: A {- ^ __C declaration:__ @arg1@ -} @@ -2516,6 +3222,13 @@ foreign import ccall unsafe "hs_bindgen_591f84e2163a5d18" noParams3 :: {- ^ __C declaration:__ @arg2@ -} -> IO () +noParams3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType noParams3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8cdf7774adb0f0b4" funptr_ret1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (IO ()))) {-| __C declaration:__ @funptr_ret1@ @@ -2525,11 +3238,18 @@ foreign import ccall unsafe "hs_bindgen_591f84e2163a5d18" noParams3 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret1@ -} -foreign import ccall unsafe "hs_bindgen_8cdf7774adb0f0b4" funptr_ret1 :: +funptr_ret1 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (IO ())) +funptr_ret1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a4e08267a9070ede" funptr_ret2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (IO FC.CInt))) {-| __C declaration:__ @funptr_ret2@ @@ -2539,11 +3259,18 @@ foreign import ccall unsafe "hs_bindgen_8cdf7774adb0f0b4" funptr_ret1 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret2@ -} -foreign import ccall unsafe "hs_bindgen_a4e08267a9070ede" funptr_ret2 :: +funptr_ret2 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (IO FC.CInt)) +funptr_ret2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_65fa30510d244cbf" funptr_ret3_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> IO ()))) {-| __C declaration:__ @funptr_ret3@ @@ -2553,11 +3280,18 @@ foreign import ccall unsafe "hs_bindgen_a4e08267a9070ede" funptr_ret2 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret3@ -} -foreign import ccall unsafe "hs_bindgen_65fa30510d244cbf" funptr_ret3 :: +funptr_ret3 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> IO ())) +funptr_ret3 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret3_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_da12eaec295883aa" funptr_ret4_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar))) {-| __C declaration:__ @funptr_ret4@ @@ -2567,11 +3301,18 @@ foreign import ccall unsafe "hs_bindgen_65fa30510d244cbf" funptr_ret3 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret4@ -} -foreign import ccall unsafe "hs_bindgen_da12eaec295883aa" funptr_ret4 :: +funptr_ret4 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO FC.CChar)) +funptr_ret4 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret4_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_281c53214b1cdcb4" funptr_ret5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret5@ @@ -2581,11 +3322,18 @@ foreign import ccall unsafe "hs_bindgen_da12eaec295883aa" funptr_ret4 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret5@ -} -foreign import ccall unsafe "hs_bindgen_281c53214b1cdcb4" funptr_ret5 :: +funptr_ret5 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret5_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_16628c257aa64a76" funptr_ret6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret6@ @@ -2595,11 +3343,18 @@ foreign import ccall unsafe "hs_bindgen_281c53214b1cdcb4" funptr_ret5 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret6@ -} -foreign import ccall unsafe "hs_bindgen_16628c257aa64a76" funptr_ret6 :: +funptr_ret6 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret6_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_79fb0c30f546a547" funptr_ret7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret7@ @@ -2609,11 +3364,18 @@ foreign import ccall unsafe "hs_bindgen_16628c257aa64a76" funptr_ret6 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret7@ -} -foreign import ccall unsafe "hs_bindgen_79fb0c30f546a547" funptr_ret7 :: +funptr_ret7 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret7_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4668d2ff9d5bfc40" funptr_ret8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret8@ @@ -2623,11 +3385,18 @@ foreign import ccall unsafe "hs_bindgen_79fb0c30f546a547" funptr_ret7 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret8@ -} -foreign import ccall unsafe "hs_bindgen_4668d2ff9d5bfc40" funptr_ret8 :: +funptr_ret8 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret8_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c044d7074789febc" funptr_ret9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret9@ @@ -2637,11 +3406,18 @@ foreign import ccall unsafe "hs_bindgen_4668d2ff9d5bfc40" funptr_ret8 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret9@ -} -foreign import ccall unsafe "hs_bindgen_c044d7074789febc" funptr_ret9 :: +funptr_ret9 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret9_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_628ced6eccc7783a" funptr_ret10_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (A -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt)))) {-| __C declaration:__ @funptr_ret10@ @@ -2651,8 +3427,10 @@ foreign import ccall unsafe "hs_bindgen_c044d7074789febc" funptr_ret9 :: __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret10@ -} -foreign import ccall unsafe "hs_bindgen_628ced6eccc7783a" funptr_ret10 :: +funptr_ret10 :: A {- ^ __C declaration:__ @arg1@ -} -> IO (Ptr.FunPtr (FC.CInt -> FC.CDouble -> IO (Ptr.Ptr FC.CInt))) +funptr_ret10 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType funptr_ret10_base diff --git a/hs-bindgen/fixtures/macros/reparse/th.txt b/hs-bindgen/fixtures/macros/reparse/th.txt index 4230da33f..60bd191a5 100644 --- a/hs-bindgen/fixtures/macros/reparse/th.txt +++ b/hs-bindgen/fixtures/macros/reparse/th.txt @@ -3958,6 +3958,22 @@ newtype INTCP -} deriving stock (Eq, Ord, Show) deriving newtype (Storable, HasBaseForeignType) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f15610128336b06a" args_char1_base :: BaseForeignType (A -> + CChar -> + IO Unit) +{-| Function declarations + +__C declaration:__ @args_char1@ + +__defined at:__ @macros\/reparse.h:17:6@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_args_char1@ +-} +args_char1 :: A -> CChar -> IO Unit {-| Function declarations __C declaration:__ @args_char1@ @@ -3968,8 +3984,21 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_args_char1@ -} -foreign import ccall safe "hs_bindgen_f15610128336b06a" args_char1 :: A -> - CChar -> IO Unit +args_char1 = fromBaseForeignType args_char1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_087f45ca0a284a03" args_char2_base :: BaseForeignType (A -> + CSChar -> + IO Unit) +{-| __C declaration:__ @args_char2@ + + __defined at:__ @macros\/reparse.h:18:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_char2@ +-} +args_char2 :: A -> CSChar -> IO Unit {-| __C declaration:__ @args_char2@ __defined at:__ @macros\/reparse.h:18:6@ @@ -3978,8 +4007,21 @@ foreign import ccall safe "hs_bindgen_f15610128336b06a" args_char1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_char2@ -} -foreign import ccall safe "hs_bindgen_087f45ca0a284a03" args_char2 :: A -> - CSChar -> IO Unit +args_char2 = fromBaseForeignType args_char2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f6cb5c5a728c2404" args_char3_base :: BaseForeignType (A -> + CUChar -> + IO Unit) +{-| __C declaration:__ @args_char3@ + + __defined at:__ @macros\/reparse.h:19:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_char3@ +-} +args_char3 :: A -> CUChar -> IO Unit {-| __C declaration:__ @args_char3@ __defined at:__ @macros\/reparse.h:19:6@ @@ -3988,8 +4030,21 @@ foreign import ccall safe "hs_bindgen_087f45ca0a284a03" args_char2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_char3@ -} -foreign import ccall safe "hs_bindgen_f6cb5c5a728c2404" args_char3 :: A -> - CUChar -> IO Unit +args_char3 = fromBaseForeignType args_char3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d485767e0caa1f7c" args_short1_base :: BaseForeignType (A -> + CShort -> + IO Unit) +{-| __C declaration:__ @args_short1@ + + __defined at:__ @macros\/reparse.h:21:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_short1@ +-} +args_short1 :: A -> CShort -> IO Unit {-| __C declaration:__ @args_short1@ __defined at:__ @macros\/reparse.h:21:6@ @@ -3998,8 +4053,21 @@ foreign import ccall safe "hs_bindgen_f6cb5c5a728c2404" args_char3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_short1@ -} -foreign import ccall safe "hs_bindgen_d485767e0caa1f7c" args_short1 :: A -> - CShort -> IO Unit +args_short1 = fromBaseForeignType args_short1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_833c96c437533e02" args_short2_base :: BaseForeignType (A -> + CShort -> + IO Unit) +{-| __C declaration:__ @args_short2@ + + __defined at:__ @macros\/reparse.h:22:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_short2@ +-} +args_short2 :: A -> CShort -> IO Unit {-| __C declaration:__ @args_short2@ __defined at:__ @macros\/reparse.h:22:6@ @@ -4008,8 +4076,12 @@ foreign import ccall safe "hs_bindgen_d485767e0caa1f7c" args_short1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_short2@ -} -foreign import ccall safe "hs_bindgen_833c96c437533e02" args_short2 :: A -> - CShort -> IO Unit +args_short2 = fromBaseForeignType args_short2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0e1eedc3fcbcea7a" args_short3_base :: BaseForeignType (A -> + CUShort -> + IO Unit) {-| __C declaration:__ @args_short3@ __defined at:__ @macros\/reparse.h:23:6@ @@ -4018,8 +4090,30 @@ foreign import ccall safe "hs_bindgen_833c96c437533e02" args_short2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_short3@ -} -foreign import ccall safe "hs_bindgen_0e1eedc3fcbcea7a" args_short3 :: A -> - CUShort -> IO Unit +args_short3 :: A -> CUShort -> IO Unit +{-| __C declaration:__ @args_short3@ + + __defined at:__ @macros\/reparse.h:23:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_short3@ +-} +args_short3 = fromBaseForeignType args_short3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_906f0ac7dfd36ab8" args_int1_base :: BaseForeignType (A -> + CInt -> + IO Unit) +{-| __C declaration:__ @args_int1@ + + __defined at:__ @macros\/reparse.h:25:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_int1@ +-} +args_int1 :: A -> CInt -> IO Unit {-| __C declaration:__ @args_int1@ __defined at:__ @macros\/reparse.h:25:6@ @@ -4028,8 +4122,21 @@ foreign import ccall safe "hs_bindgen_0e1eedc3fcbcea7a" args_short3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_int1@ -} -foreign import ccall safe "hs_bindgen_906f0ac7dfd36ab8" args_int1 :: A -> - CInt -> IO Unit +args_int1 = fromBaseForeignType args_int1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0edbc9b995b2a589" args_int2_base :: BaseForeignType (A -> + CInt -> + IO Unit) +{-| __C declaration:__ @args_int2@ + + __defined at:__ @macros\/reparse.h:26:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_int2@ +-} +args_int2 :: A -> CInt -> IO Unit {-| __C declaration:__ @args_int2@ __defined at:__ @macros\/reparse.h:26:6@ @@ -4038,8 +4145,21 @@ foreign import ccall safe "hs_bindgen_906f0ac7dfd36ab8" args_int1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_int2@ -} -foreign import ccall safe "hs_bindgen_0edbc9b995b2a589" args_int2 :: A -> - CInt -> IO Unit +args_int2 = fromBaseForeignType args_int2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a5c223f58a255115" args_int3_base :: BaseForeignType (A -> + CUInt -> + IO Unit) +{-| __C declaration:__ @args_int3@ + + __defined at:__ @macros\/reparse.h:27:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_int3@ +-} +args_int3 :: A -> CUInt -> IO Unit {-| __C declaration:__ @args_int3@ __defined at:__ @macros\/reparse.h:27:6@ @@ -4048,8 +4168,21 @@ foreign import ccall safe "hs_bindgen_0edbc9b995b2a589" args_int2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_int3@ -} -foreign import ccall safe "hs_bindgen_a5c223f58a255115" args_int3 :: A -> - CUInt -> IO Unit +args_int3 = fromBaseForeignType args_int3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_41d1229384b9a529" args_long1_base :: BaseForeignType (A -> + CLong -> + IO Unit) +{-| __C declaration:__ @args_long1@ + + __defined at:__ @macros\/reparse.h:29:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_long1@ +-} +args_long1 :: A -> CLong -> IO Unit {-| __C declaration:__ @args_long1@ __defined at:__ @macros\/reparse.h:29:6@ @@ -4058,8 +4191,21 @@ foreign import ccall safe "hs_bindgen_a5c223f58a255115" args_int3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_long1@ -} -foreign import ccall safe "hs_bindgen_41d1229384b9a529" args_long1 :: A -> - CLong -> IO Unit +args_long1 = fromBaseForeignType args_long1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a9a4b09fd3bd83db" args_long2_base :: BaseForeignType (A -> + CLong -> + IO Unit) +{-| __C declaration:__ @args_long2@ + + __defined at:__ @macros\/reparse.h:30:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_long2@ +-} +args_long2 :: A -> CLong -> IO Unit {-| __C declaration:__ @args_long2@ __defined at:__ @macros\/reparse.h:30:6@ @@ -4068,8 +4214,21 @@ foreign import ccall safe "hs_bindgen_41d1229384b9a529" args_long1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_long2@ -} -foreign import ccall safe "hs_bindgen_a9a4b09fd3bd83db" args_long2 :: A -> - CLong -> IO Unit +args_long2 = fromBaseForeignType args_long2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_31dc2e680b3f3eff" args_long3_base :: BaseForeignType (A -> + CULong -> + IO Unit) +{-| __C declaration:__ @args_long3@ + + __defined at:__ @macros\/reparse.h:31:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_long3@ +-} +args_long3 :: A -> CULong -> IO Unit {-| __C declaration:__ @args_long3@ __defined at:__ @macros\/reparse.h:31:6@ @@ -4078,8 +4237,21 @@ foreign import ccall safe "hs_bindgen_a9a4b09fd3bd83db" args_long2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_long3@ -} -foreign import ccall safe "hs_bindgen_31dc2e680b3f3eff" args_long3 :: A -> - CULong -> IO Unit +args_long3 = fromBaseForeignType args_long3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3d400757b5cbf4b7" args_float_base :: BaseForeignType (A -> + CFloat -> + IO Unit) +{-| __C declaration:__ @args_float@ + + __defined at:__ @macros\/reparse.h:33:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_float@ +-} +args_float :: A -> CFloat -> IO Unit {-| __C declaration:__ @args_float@ __defined at:__ @macros\/reparse.h:33:6@ @@ -4088,8 +4260,21 @@ foreign import ccall safe "hs_bindgen_31dc2e680b3f3eff" args_long3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_float@ -} -foreign import ccall safe "hs_bindgen_3d400757b5cbf4b7" args_float :: A -> - CFloat -> IO Unit +args_float = fromBaseForeignType args_float_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_70df07e39900487e" args_double_base :: BaseForeignType (A -> + CDouble -> + IO Unit) +{-| __C declaration:__ @args_double@ + + __defined at:__ @macros\/reparse.h:34:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_double@ +-} +args_double :: A -> CDouble -> IO Unit {-| __C declaration:__ @args_double@ __defined at:__ @macros\/reparse.h:34:6@ @@ -4098,8 +4283,21 @@ foreign import ccall safe "hs_bindgen_3d400757b5cbf4b7" args_float :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_double@ -} -foreign import ccall safe "hs_bindgen_70df07e39900487e" args_double :: A -> - CDouble -> IO Unit +args_double = fromBaseForeignType args_double_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0b7c534fe683f843" args_bool1_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @args_bool1@ + + __defined at:__ @macros\/reparse.h:35:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_bool1@ +-} +args_bool1 :: A -> CBool -> IO Unit {-| __C declaration:__ @args_bool1@ __defined at:__ @macros\/reparse.h:35:6@ @@ -4108,15 +4306,22 @@ foreign import ccall safe "hs_bindgen_70df07e39900487e" args_double :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_bool1@ -} -foreign import ccall safe "hs_bindgen_0b7c534fe683f843" args_bool1 :: A -> - CBool -> IO Unit +args_bool1 = fromBaseForeignType args_bool1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b20e084f7b7941b5" args_struct_wrapper_base :: BaseForeignType (A -> + Ptr Some_struct -> + IO Unit) +{-| Pointer-based API for 'args_struct' + +__unique:__ @test_macrosreparse_Example_Unsafe_args_struct@ +-} +args_struct_wrapper :: A -> Ptr Some_struct -> IO Unit {-| Pointer-based API for 'args_struct' __unique:__ @test_macrosreparse_Example_Unsafe_args_struct@ -} -foreign import ccall safe "hs_bindgen_b20e084f7b7941b5" args_struct_wrapper :: A -> - Ptr Some_struct -> - IO Unit +args_struct_wrapper = fromBaseForeignType args_struct_wrapper_base {-| __C declaration:__ @args_struct@ __defined at:__ @macros\/reparse.h:37:6@ @@ -4131,13 +4336,21 @@ args_struct :: A -> Some_struct -> IO Unit __exported by:__ @macros\/reparse.h@ -} args_struct = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_struct_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_23aff33f33b6bdd1" args_union_wrapper_base :: BaseForeignType (A -> + Ptr Some_union -> + IO Unit) +{-| Pointer-based API for 'args_union' + +__unique:__ @test_macrosreparse_Example_Unsafe_args_union@ +-} +args_union_wrapper :: A -> Ptr Some_union -> IO Unit {-| Pointer-based API for 'args_union' __unique:__ @test_macrosreparse_Example_Unsafe_args_union@ -} -foreign import ccall safe "hs_bindgen_23aff33f33b6bdd1" args_union_wrapper :: A -> - Ptr Some_union -> - IO Unit +args_union_wrapper = fromBaseForeignType args_union_wrapper_base {-| __C declaration:__ @args_union@ __defined at:__ @macros\/reparse.h:38:6@ @@ -4152,6 +4365,20 @@ args_union :: A -> Some_union -> IO Unit __exported by:__ @macros\/reparse.h@ -} args_union = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_union_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fdd58ae14ce15ed5" args_enum_base :: BaseForeignType (A -> + Some_enum -> + IO Unit) +{-| __C declaration:__ @args_enum@ + + __defined at:__ @macros\/reparse.h:39:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_enum@ +-} +args_enum :: A -> Some_enum -> IO Unit {-| __C declaration:__ @args_enum@ __defined at:__ @macros\/reparse.h:39:6@ @@ -4160,8 +4387,21 @@ args_union = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_union_wrapper x_0 y_2) __unique:__ @test_macrosreparse_Example_Unsafe_args_enum@ -} -foreign import ccall safe "hs_bindgen_fdd58ae14ce15ed5" args_enum :: A -> - Some_enum -> IO Unit +args_enum = fromBaseForeignType args_enum_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_42ce2ec4fd2eda72" args_pointer1_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @args_pointer1@ + + __defined at:__ @macros\/reparse.h:41:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer1@ +-} +args_pointer1 :: A -> Ptr CInt -> IO Unit {-| __C declaration:__ @args_pointer1@ __defined at:__ @macros\/reparse.h:41:6@ @@ -4170,8 +4410,21 @@ foreign import ccall safe "hs_bindgen_fdd58ae14ce15ed5" args_enum :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer1@ -} -foreign import ccall safe "hs_bindgen_42ce2ec4fd2eda72" args_pointer1 :: A -> - Ptr CInt -> IO Unit +args_pointer1 = fromBaseForeignType args_pointer1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_01b2f6502d340abe" args_pointer2_base :: BaseForeignType (A -> + Ptr (Ptr CInt) -> + IO Unit) +{-| __C declaration:__ @args_pointer2@ + + __defined at:__ @macros\/reparse.h:42:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer2@ +-} +args_pointer2 :: A -> Ptr (Ptr CInt) -> IO Unit {-| __C declaration:__ @args_pointer2@ __defined at:__ @macros\/reparse.h:42:6@ @@ -4180,8 +4433,21 @@ foreign import ccall safe "hs_bindgen_42ce2ec4fd2eda72" args_pointer1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer2@ -} -foreign import ccall safe "hs_bindgen_01b2f6502d340abe" args_pointer2 :: A -> - Ptr (Ptr CInt) -> IO Unit +args_pointer2 = fromBaseForeignType args_pointer2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3e64133f9aaebbf1" args_pointer3_base :: BaseForeignType (A -> + Ptr Void -> + IO Unit) +{-| __C declaration:__ @args_pointer3@ + + __defined at:__ @macros\/reparse.h:43:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer3@ +-} +args_pointer3 :: A -> Ptr Void -> IO Unit {-| __C declaration:__ @args_pointer3@ __defined at:__ @macros\/reparse.h:43:6@ @@ -4190,8 +4456,19 @@ foreign import ccall safe "hs_bindgen_01b2f6502d340abe" args_pointer2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer3@ -} -foreign import ccall safe "hs_bindgen_3e64133f9aaebbf1" args_pointer3 :: A -> - Ptr Void -> IO Unit +args_pointer3 = fromBaseForeignType args_pointer3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c830401b459192fb" ret_A_base :: BaseForeignType (IO A) +{-| __C declaration:__ @ret_A@ + + __defined at:__ @macros\/reparse.h:47:3@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_A@ +-} +ret_A :: IO A {-| __C declaration:__ @ret_A@ __defined at:__ @macros\/reparse.h:47:3@ @@ -4200,7 +4477,20 @@ foreign import ccall safe "hs_bindgen_3e64133f9aaebbf1" args_pointer3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_A@ -} -foreign import ccall safe "hs_bindgen_c830401b459192fb" ret_A :: IO A +ret_A = fromBaseForeignType ret_A_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_18b24c6e67a5412e" ret_char1_base :: BaseForeignType (A -> + IO CChar) +{-| __C declaration:__ @ret_char1@ + + __defined at:__ @macros\/reparse.h:49:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_char1@ +-} +ret_char1 :: A -> IO CChar {-| __C declaration:__ @ret_char1@ __defined at:__ @macros\/reparse.h:49:20@ @@ -4209,8 +4499,20 @@ foreign import ccall safe "hs_bindgen_c830401b459192fb" ret_A :: IO A __unique:__ @test_macrosreparse_Example_Unsafe_ret_char1@ -} -foreign import ccall safe "hs_bindgen_18b24c6e67a5412e" ret_char1 :: A -> - IO CChar +ret_char1 = fromBaseForeignType ret_char1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2da1160aeef9ff64" ret_char2_base :: BaseForeignType (A -> + IO CSChar) +{-| __C declaration:__ @ret_char2@ + + __defined at:__ @macros\/reparse.h:50:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_char2@ +-} +ret_char2 :: A -> IO CSChar {-| __C declaration:__ @ret_char2@ __defined at:__ @macros\/reparse.h:50:20@ @@ -4219,8 +4521,20 @@ foreign import ccall safe "hs_bindgen_18b24c6e67a5412e" ret_char1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_char2@ -} -foreign import ccall safe "hs_bindgen_2da1160aeef9ff64" ret_char2 :: A -> - IO CSChar +ret_char2 = fromBaseForeignType ret_char2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e3183f9de1b9f231" ret_char3_base :: BaseForeignType (A -> + IO CUChar) +{-| __C declaration:__ @ret_char3@ + + __defined at:__ @macros\/reparse.h:51:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_char3@ +-} +ret_char3 :: A -> IO CUChar {-| __C declaration:__ @ret_char3@ __defined at:__ @macros\/reparse.h:51:20@ @@ -4229,8 +4543,20 @@ foreign import ccall safe "hs_bindgen_2da1160aeef9ff64" ret_char2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_char3@ -} -foreign import ccall safe "hs_bindgen_e3183f9de1b9f231" ret_char3 :: A -> - IO CUChar +ret_char3 = fromBaseForeignType ret_char3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c313966d4478e3f4" ret_short1_base :: BaseForeignType (A -> + IO CShort) +{-| __C declaration:__ @ret_short1@ + + __defined at:__ @macros\/reparse.h:53:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_short1@ +-} +ret_short1 :: A -> IO CShort {-| __C declaration:__ @ret_short1@ __defined at:__ @macros\/reparse.h:53:20@ @@ -4239,8 +4565,20 @@ foreign import ccall safe "hs_bindgen_e3183f9de1b9f231" ret_char3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_short1@ -} -foreign import ccall safe "hs_bindgen_c313966d4478e3f4" ret_short1 :: A -> - IO CShort +ret_short1 = fromBaseForeignType ret_short1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_737fbec310eb0719" ret_short2_base :: BaseForeignType (A -> + IO CShort) +{-| __C declaration:__ @ret_short2@ + + __defined at:__ @macros\/reparse.h:54:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_short2@ +-} +ret_short2 :: A -> IO CShort {-| __C declaration:__ @ret_short2@ __defined at:__ @macros\/reparse.h:54:20@ @@ -4249,8 +4587,20 @@ foreign import ccall safe "hs_bindgen_c313966d4478e3f4" ret_short1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_short2@ -} -foreign import ccall safe "hs_bindgen_737fbec310eb0719" ret_short2 :: A -> - IO CShort +ret_short2 = fromBaseForeignType ret_short2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b5bd9e111020db4e" ret_short3_base :: BaseForeignType (A -> + IO CUShort) +{-| __C declaration:__ @ret_short3@ + + __defined at:__ @macros\/reparse.h:55:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_short3@ +-} +ret_short3 :: A -> IO CUShort {-| __C declaration:__ @ret_short3@ __defined at:__ @macros\/reparse.h:55:20@ @@ -4259,8 +4609,20 @@ foreign import ccall safe "hs_bindgen_737fbec310eb0719" ret_short2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_short3@ -} -foreign import ccall safe "hs_bindgen_b5bd9e111020db4e" ret_short3 :: A -> - IO CUShort +ret_short3 = fromBaseForeignType ret_short3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a30224259287f5f8" ret_int1_base :: BaseForeignType (A -> + IO CInt) +{-| __C declaration:__ @ret_int1@ + + __defined at:__ @macros\/reparse.h:57:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_int1@ +-} +ret_int1 :: A -> IO CInt {-| __C declaration:__ @ret_int1@ __defined at:__ @macros\/reparse.h:57:20@ @@ -4269,8 +4631,11 @@ foreign import ccall safe "hs_bindgen_b5bd9e111020db4e" ret_short3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_int1@ -} -foreign import ccall safe "hs_bindgen_a30224259287f5f8" ret_int1 :: A -> - IO CInt +ret_int1 = fromBaseForeignType ret_int1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b5be09caf8cf5750" ret_int2_base :: BaseForeignType (A -> + IO CInt) {-| __C declaration:__ @ret_int2@ __defined at:__ @macros\/reparse.h:58:20@ @@ -4279,8 +4644,29 @@ foreign import ccall safe "hs_bindgen_a30224259287f5f8" ret_int1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_int2@ -} -foreign import ccall safe "hs_bindgen_b5be09caf8cf5750" ret_int2 :: A -> - IO CInt +ret_int2 :: A -> IO CInt +{-| __C declaration:__ @ret_int2@ + + __defined at:__ @macros\/reparse.h:58:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_int2@ +-} +ret_int2 = fromBaseForeignType ret_int2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_698e3f97470d83be" ret_int3_base :: BaseForeignType (A -> + IO CUInt) +{-| __C declaration:__ @ret_int3@ + + __defined at:__ @macros\/reparse.h:59:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_int3@ +-} +ret_int3 :: A -> IO CUInt {-| __C declaration:__ @ret_int3@ __defined at:__ @macros\/reparse.h:59:20@ @@ -4289,8 +4675,20 @@ foreign import ccall safe "hs_bindgen_b5be09caf8cf5750" ret_int2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_int3@ -} -foreign import ccall safe "hs_bindgen_698e3f97470d83be" ret_int3 :: A -> - IO CUInt +ret_int3 = fromBaseForeignType ret_int3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c7e0705dd09be530" ret_long1_base :: BaseForeignType (A -> + IO CLong) +{-| __C declaration:__ @ret_long1@ + + __defined at:__ @macros\/reparse.h:61:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_long1@ +-} +ret_long1 :: A -> IO CLong {-| __C declaration:__ @ret_long1@ __defined at:__ @macros\/reparse.h:61:20@ @@ -4299,8 +4697,20 @@ foreign import ccall safe "hs_bindgen_698e3f97470d83be" ret_int3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_long1@ -} -foreign import ccall safe "hs_bindgen_c7e0705dd09be530" ret_long1 :: A -> - IO CLong +ret_long1 = fromBaseForeignType ret_long1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_74b1f5b8c56ff22c" ret_long2_base :: BaseForeignType (A -> + IO CLong) +{-| __C declaration:__ @ret_long2@ + + __defined at:__ @macros\/reparse.h:62:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_long2@ +-} +ret_long2 :: A -> IO CLong {-| __C declaration:__ @ret_long2@ __defined at:__ @macros\/reparse.h:62:20@ @@ -4309,8 +4719,20 @@ foreign import ccall safe "hs_bindgen_c7e0705dd09be530" ret_long1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_long2@ -} -foreign import ccall safe "hs_bindgen_74b1f5b8c56ff22c" ret_long2 :: A -> - IO CLong +ret_long2 = fromBaseForeignType ret_long2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c2d07eaaab82d408" ret_long3_base :: BaseForeignType (A -> + IO CULong) +{-| __C declaration:__ @ret_long3@ + + __defined at:__ @macros\/reparse.h:63:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_long3@ +-} +ret_long3 :: A -> IO CULong {-| __C declaration:__ @ret_long3@ __defined at:__ @macros\/reparse.h:63:20@ @@ -4319,8 +4741,20 @@ foreign import ccall safe "hs_bindgen_74b1f5b8c56ff22c" ret_long2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_long3@ -} -foreign import ccall safe "hs_bindgen_c2d07eaaab82d408" ret_long3 :: A -> - IO CULong +ret_long3 = fromBaseForeignType ret_long3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0edfbc7067faa1f7" ret_float_base :: BaseForeignType (A -> + IO CFloat) +{-| __C declaration:__ @ret_float@ + + __defined at:__ @macros\/reparse.h:65:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_float@ +-} +ret_float :: A -> IO CFloat {-| __C declaration:__ @ret_float@ __defined at:__ @macros\/reparse.h:65:20@ @@ -4329,8 +4763,20 @@ foreign import ccall safe "hs_bindgen_c2d07eaaab82d408" ret_long3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_float@ -} -foreign import ccall safe "hs_bindgen_0edfbc7067faa1f7" ret_float :: A -> - IO CFloat +ret_float = fromBaseForeignType ret_float_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_786ca672396b33be" ret_double_base :: BaseForeignType (A -> + IO CDouble) +{-| __C declaration:__ @ret_double@ + + __defined at:__ @macros\/reparse.h:66:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_double@ +-} +ret_double :: A -> IO CDouble {-| __C declaration:__ @ret_double@ __defined at:__ @macros\/reparse.h:66:20@ @@ -4339,8 +4785,20 @@ foreign import ccall safe "hs_bindgen_0edfbc7067faa1f7" ret_float :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_double@ -} -foreign import ccall safe "hs_bindgen_786ca672396b33be" ret_double :: A -> - IO CDouble +ret_double = fromBaseForeignType ret_double_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2e99f19b59650996" ret_bool1_base :: BaseForeignType (A -> + IO CBool) +{-| __C declaration:__ @ret_bool1@ + + __defined at:__ @macros\/reparse.h:67:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_bool1@ +-} +ret_bool1 :: A -> IO CBool {-| __C declaration:__ @ret_bool1@ __defined at:__ @macros\/reparse.h:67:20@ @@ -4349,15 +4807,22 @@ foreign import ccall safe "hs_bindgen_786ca672396b33be" ret_double :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_bool1@ -} -foreign import ccall safe "hs_bindgen_2e99f19b59650996" ret_bool1 :: A -> - IO CBool +ret_bool1 = fromBaseForeignType ret_bool1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6c999121eed8178f" ret_struct_wrapper_base :: BaseForeignType (A -> + Ptr Some_struct -> + IO Unit) {-| Pointer-based API for 'ret_struct' __unique:__ @test_macrosreparse_Example_Unsafe_ret_struct@ -} -foreign import ccall safe "hs_bindgen_6c999121eed8178f" ret_struct_wrapper :: A -> - Ptr Some_struct -> - IO Unit +ret_struct_wrapper :: A -> Ptr Some_struct -> IO Unit +{-| Pointer-based API for 'ret_struct' + +__unique:__ @test_macrosreparse_Example_Unsafe_ret_struct@ +-} +ret_struct_wrapper = fromBaseForeignType ret_struct_wrapper_base {-| __C declaration:__ @ret_struct@ __defined at:__ @macros\/reparse.h:69:20@ @@ -4372,13 +4837,21 @@ ret_struct :: A -> IO Some_struct __exported by:__ @macros\/reparse.h@ -} ret_struct = \x_0 -> allocaAndPeek (\z_1 -> ret_struct_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_481ee5d2d9bd34db" ret_union_wrapper_base :: BaseForeignType (A -> + Ptr Some_union -> + IO Unit) +{-| Pointer-based API for 'ret_union' + +__unique:__ @test_macrosreparse_Example_Unsafe_ret_union@ +-} +ret_union_wrapper :: A -> Ptr Some_union -> IO Unit {-| Pointer-based API for 'ret_union' __unique:__ @test_macrosreparse_Example_Unsafe_ret_union@ -} -foreign import ccall safe "hs_bindgen_481ee5d2d9bd34db" ret_union_wrapper :: A -> - Ptr Some_union -> - IO Unit +ret_union_wrapper = fromBaseForeignType ret_union_wrapper_base {-| __C declaration:__ @ret_union@ __defined at:__ @macros\/reparse.h:70:20@ @@ -4393,6 +4866,19 @@ ret_union :: A -> IO Some_union __exported by:__ @macros\/reparse.h@ -} ret_union = \x_0 -> allocaAndPeek (\z_1 -> ret_union_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8bb240ba453b700d" ret_enum_base :: BaseForeignType (A -> + IO Some_enum) +{-| __C declaration:__ @ret_enum@ + + __defined at:__ @macros\/reparse.h:71:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_enum@ +-} +ret_enum :: A -> IO Some_enum {-| __C declaration:__ @ret_enum@ __defined at:__ @macros\/reparse.h:71:20@ @@ -4401,8 +4887,20 @@ ret_union = \x_0 -> allocaAndPeek (\z_1 -> ret_union_wrapper x_0 z_1) __unique:__ @test_macrosreparse_Example_Unsafe_ret_enum@ -} -foreign import ccall safe "hs_bindgen_8bb240ba453b700d" ret_enum :: A -> - IO Some_enum +ret_enum = fromBaseForeignType ret_enum_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c346ed2cd20b9af1" ret_pointer1_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @ret_pointer1@ + + __defined at:__ @macros\/reparse.h:73:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer1@ +-} +ret_pointer1 :: A -> IO (Ptr CInt) {-| __C declaration:__ @ret_pointer1@ __defined at:__ @macros\/reparse.h:73:20@ @@ -4411,8 +4909,20 @@ foreign import ccall safe "hs_bindgen_8bb240ba453b700d" ret_enum :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer1@ -} -foreign import ccall safe "hs_bindgen_c346ed2cd20b9af1" ret_pointer1 :: A -> - IO (Ptr CInt) +ret_pointer1 = fromBaseForeignType ret_pointer1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a21f618658151728" ret_pointer2_base :: BaseForeignType (A -> + IO (Ptr (Ptr CInt))) +{-| __C declaration:__ @ret_pointer2@ + + __defined at:__ @macros\/reparse.h:74:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer2@ +-} +ret_pointer2 :: A -> IO (Ptr (Ptr CInt)) {-| __C declaration:__ @ret_pointer2@ __defined at:__ @macros\/reparse.h:74:20@ @@ -4421,8 +4931,20 @@ foreign import ccall safe "hs_bindgen_c346ed2cd20b9af1" ret_pointer1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer2@ -} -foreign import ccall safe "hs_bindgen_a21f618658151728" ret_pointer2 :: A -> - IO (Ptr (Ptr CInt)) +ret_pointer2 = fromBaseForeignType ret_pointer2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2d8c6e2d2f395342" ret_pointer3_base :: BaseForeignType (A -> + IO (Ptr Void)) +{-| __C declaration:__ @ret_pointer3@ + + __defined at:__ @macros\/reparse.h:75:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer3@ +-} +ret_pointer3 :: A -> IO (Ptr Void) {-| __C declaration:__ @ret_pointer3@ __defined at:__ @macros\/reparse.h:75:20@ @@ -4431,8 +4953,20 @@ foreign import ccall safe "hs_bindgen_a21f618658151728" ret_pointer2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer3@ -} -foreign import ccall safe "hs_bindgen_2d8c6e2d2f395342" ret_pointer3 :: A -> - IO (Ptr Void) +ret_pointer3 = fromBaseForeignType ret_pointer3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b030d02030ed80bc" body1_base :: BaseForeignType (A -> + IO CInt) +{-| __C declaration:__ @body1@ + + __defined at:__ @macros\/reparse.h:79:5@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_body1@ +-} +body1 :: A -> IO CInt {-| __C declaration:__ @body1@ __defined at:__ @macros\/reparse.h:79:5@ @@ -4441,8 +4975,19 @@ foreign import ccall safe "hs_bindgen_2d8c6e2d2f395342" ret_pointer3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_body1@ -} -foreign import ccall safe "hs_bindgen_b030d02030ed80bc" body1 :: A -> - IO CInt +body1 = fromBaseForeignType body1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_be50427e6a63df54" body2_base :: BaseForeignType (IO A) +{-| __C declaration:__ @body2@ + + __defined at:__ @macros\/reparse.h:80:3@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_body2@ +-} +body2 :: IO A {-| __C declaration:__ @body2@ __defined at:__ @macros\/reparse.h:80:3@ @@ -4451,14 +4996,22 @@ foreign import ccall safe "hs_bindgen_b030d02030ed80bc" body1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_body2@ -} -foreign import ccall safe "hs_bindgen_be50427e6a63df54" body2 :: IO A +body2 = fromBaseForeignType body2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_627a52a5c7617083" args_complex_float_wrapper_base :: BaseForeignType (A -> + Ptr (Complex CFloat) -> + IO Unit) {-| Pointer-based API for 'args_complex_float' __unique:__ @test_macrosreparse_Example_Unsafe_args_complex_float@ -} -foreign import ccall safe "hs_bindgen_627a52a5c7617083" args_complex_float_wrapper :: A -> - Ptr (Complex CFloat) -> - IO Unit +args_complex_float_wrapper :: A -> Ptr (Complex CFloat) -> IO Unit +{-| Pointer-based API for 'args_complex_float' + +__unique:__ @test_macrosreparse_Example_Unsafe_args_complex_float@ +-} +args_complex_float_wrapper = fromBaseForeignType args_complex_float_wrapper_base {-| __C declaration:__ @args_complex_float@ __defined at:__ @macros\/reparse.h:84:6@ @@ -4473,13 +5026,22 @@ args_complex_float :: A -> Complex CFloat -> IO Unit __exported by:__ @macros\/reparse.h@ -} args_complex_float = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_complex_float_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_392babebc1d83503" args_complex_double_wrapper_base :: BaseForeignType (A -> + Ptr (Complex CDouble) -> + IO Unit) +{-| Pointer-based API for 'args_complex_double' + +__unique:__ @test_macrosreparse_Example_Unsafe_args_complex_double@ +-} +args_complex_double_wrapper :: A -> + Ptr (Complex CDouble) -> IO Unit {-| Pointer-based API for 'args_complex_double' __unique:__ @test_macrosreparse_Example_Unsafe_args_complex_double@ -} -foreign import ccall safe "hs_bindgen_392babebc1d83503" args_complex_double_wrapper :: A -> - Ptr (Complex CDouble) -> - IO Unit +args_complex_double_wrapper = fromBaseForeignType args_complex_double_wrapper_base {-| __C declaration:__ @args_complex_double@ __defined at:__ @macros\/reparse.h:85:6@ @@ -4494,13 +5056,21 @@ args_complex_double :: A -> Complex CDouble -> IO Unit __exported by:__ @macros\/reparse.h@ -} args_complex_double = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_complex_double_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8958183ede73dea8" ret_complex_float_wrapper_base :: BaseForeignType (A -> + Ptr (Complex CFloat) -> + IO Unit) +{-| Pointer-based API for 'ret_complex_float' + +__unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_float@ +-} +ret_complex_float_wrapper :: A -> Ptr (Complex CFloat) -> IO Unit {-| Pointer-based API for 'ret_complex_float' __unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_float@ -} -foreign import ccall safe "hs_bindgen_8958183ede73dea8" ret_complex_float_wrapper :: A -> - Ptr (Complex CFloat) -> - IO Unit +ret_complex_float_wrapper = fromBaseForeignType ret_complex_float_wrapper_base {-| __C declaration:__ @ret_complex_float@ __defined at:__ @macros\/reparse.h:86:17@ @@ -4515,13 +5085,21 @@ ret_complex_float :: A -> IO (Complex CFloat) __exported by:__ @macros\/reparse.h@ -} ret_complex_float = \x_0 -> allocaAndPeek (\z_1 -> ret_complex_float_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a95fabfd391a99aa" ret_complex_double_wrapper_base :: BaseForeignType (A -> + Ptr (Complex CDouble) -> + IO Unit) +{-| Pointer-based API for 'ret_complex_double' + +__unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_double@ +-} +ret_complex_double_wrapper :: A -> Ptr (Complex CDouble) -> IO Unit {-| Pointer-based API for 'ret_complex_double' __unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_double@ -} -foreign import ccall safe "hs_bindgen_a95fabfd391a99aa" ret_complex_double_wrapper :: A -> - Ptr (Complex CDouble) -> - IO Unit +ret_complex_double_wrapper = fromBaseForeignType ret_complex_double_wrapper_base {-| __C declaration:__ @ret_complex_double@ __defined at:__ @macros\/reparse.h:87:17@ @@ -4536,6 +5114,20 @@ ret_complex_double :: A -> IO (Complex CDouble) __exported by:__ @macros\/reparse.h@ -} ret_complex_double = \x_0 -> allocaAndPeek (\z_1 -> ret_complex_double_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ad9f8630dd04a203" bespoke_args1_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @bespoke_args1@ + + __defined at:__ @macros\/reparse.h:94:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args1@ +-} +bespoke_args1 :: A -> CBool -> IO Unit {-| __C declaration:__ @bespoke_args1@ __defined at:__ @macros\/reparse.h:94:6@ @@ -4544,8 +5136,21 @@ ret_complex_double = \x_0 -> allocaAndPeek (\z_1 -> ret_complex_double_wrapper x __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args1@ -} -foreign import ccall safe "hs_bindgen_ad9f8630dd04a203" bespoke_args1 :: A -> - CBool -> IO Unit +bespoke_args1 = fromBaseForeignType bespoke_args1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4b34178a505131e2" bespoke_args2_base :: BaseForeignType (A -> + HsBindgen.Runtime.Prelude.CSize -> + IO Unit) +{-| __C declaration:__ @bespoke_args2@ + + __defined at:__ @macros\/reparse.h:95:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args2@ +-} +bespoke_args2 :: A -> HsBindgen.Runtime.Prelude.CSize -> IO Unit {-| __C declaration:__ @bespoke_args2@ __defined at:__ @macros\/reparse.h:95:6@ @@ -4554,9 +5159,20 @@ foreign import ccall safe "hs_bindgen_ad9f8630dd04a203" bespoke_args1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args2@ -} -foreign import ccall safe "hs_bindgen_4b34178a505131e2" bespoke_args2 :: A -> - HsBindgen.Runtime.Prelude.CSize -> - IO Unit +bespoke_args2 = fromBaseForeignType bespoke_args2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_94b225a6394496c1" bespoke_ret1_base :: BaseForeignType (A -> + IO CBool) +{-| __C declaration:__ @bespoke_ret1@ + + __defined at:__ @macros\/reparse.h:97:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret1@ +-} +bespoke_ret1 :: A -> IO CBool {-| __C declaration:__ @bespoke_ret1@ __defined at:__ @macros\/reparse.h:97:8@ @@ -4565,8 +5181,20 @@ foreign import ccall safe "hs_bindgen_4b34178a505131e2" bespoke_args2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret1@ -} -foreign import ccall safe "hs_bindgen_94b225a6394496c1" bespoke_ret1 :: A -> - IO CBool +bespoke_ret1 = fromBaseForeignType bespoke_ret1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7c9a1792426b84a1" bespoke_ret2_base :: BaseForeignType (A -> + IO HsBindgen.Runtime.Prelude.CSize) +{-| __C declaration:__ @bespoke_ret2@ + + __defined at:__ @macros\/reparse.h:98:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret2@ +-} +bespoke_ret2 :: A -> IO HsBindgen.Runtime.Prelude.CSize {-| __C declaration:__ @bespoke_ret2@ __defined at:__ @macros\/reparse.h:98:8@ @@ -4575,8 +5203,11 @@ foreign import ccall safe "hs_bindgen_94b225a6394496c1" bespoke_ret1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret2@ -} -foreign import ccall safe "hs_bindgen_7c9a1792426b84a1" bespoke_ret2 :: A -> - IO HsBindgen.Runtime.Prelude.CSize +bespoke_ret2 = fromBaseForeignType bespoke_ret2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e20689fe39004225" arr_args1_base :: BaseForeignType (Ptr A -> + IO Unit) {-| Arrays __C declaration:__ @arr_args1@ @@ -4587,8 +5218,31 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_arr_args1@ -} -foreign import ccall safe "hs_bindgen_e20689fe39004225" arr_args1 :: Ptr A -> - IO Unit +arr_args1 :: Ptr A -> IO Unit +{-| Arrays + +__C declaration:__ @arr_args1@ + +__defined at:__ @macros\/reparse.h:104:6@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_arr_args1@ +-} +arr_args1 = fromBaseForeignType arr_args1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_084796e4bfd3f4cd" arr_args2_base :: BaseForeignType (Ptr (Ptr A) -> + IO Unit) +{-| __C declaration:__ @arr_args2@ + + __defined at:__ @macros\/reparse.h:105:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_arr_args2@ +-} +arr_args2 :: Ptr (Ptr A) -> IO Unit {-| __C declaration:__ @arr_args2@ __defined at:__ @macros\/reparse.h:105:6@ @@ -4597,8 +5251,20 @@ foreign import ccall safe "hs_bindgen_e20689fe39004225" arr_args1 :: Ptr A -> __unique:__ @test_macrosreparse_Example_Unsafe_arr_args2@ -} -foreign import ccall safe "hs_bindgen_084796e4bfd3f4cd" arr_args2 :: Ptr (Ptr A) -> - IO Unit +arr_args2 = fromBaseForeignType arr_args2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a3d1560aaa4352df" arr_args3_base :: BaseForeignType (Ptr A -> + IO Unit) +{-| __C declaration:__ @arr_args3@ + + __defined at:__ @macros\/reparse.h:106:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_arr_args3@ +-} +arr_args3 :: Ptr A -> IO Unit {-| __C declaration:__ @arr_args3@ __defined at:__ @macros\/reparse.h:106:6@ @@ -4607,8 +5273,20 @@ foreign import ccall safe "hs_bindgen_084796e4bfd3f4cd" arr_args2 :: Ptr (Ptr A) __unique:__ @test_macrosreparse_Example_Unsafe_arr_args3@ -} -foreign import ccall safe "hs_bindgen_a3d1560aaa4352df" arr_args3 :: Ptr A -> - IO Unit +arr_args3 = fromBaseForeignType arr_args3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_88659ccccc6c1f5f" arr_args4_base :: BaseForeignType (Ptr (Ptr A) -> + IO Unit) +{-| __C declaration:__ @arr_args4@ + + __defined at:__ @macros\/reparse.h:107:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_arr_args4@ +-} +arr_args4 :: Ptr (Ptr A) -> IO Unit {-| __C declaration:__ @arr_args4@ __defined at:__ @macros\/reparse.h:107:6@ @@ -4617,8 +5295,23 @@ foreign import ccall safe "hs_bindgen_a3d1560aaa4352df" arr_args3 :: Ptr A -> __unique:__ @test_macrosreparse_Example_Unsafe_arr_args4@ -} -foreign import ccall safe "hs_bindgen_88659ccccc6c1f5f" arr_args4 :: Ptr (Ptr A) -> - IO Unit +arr_args4 = fromBaseForeignType arr_args4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3448d03cfd41161a" funptr_args1_base :: BaseForeignType (A -> + FunPtr (IO Unit) -> + IO Unit) +{-| Function pointers + +__C declaration:__ @funptr_args1@ + +__defined at:__ @macros\/reparse.h:126:6@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_funptr_args1@ +-} +funptr_args1 :: A -> FunPtr (IO Unit) -> IO Unit {-| Function pointers __C declaration:__ @funptr_args1@ @@ -4629,8 +5322,21 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args1@ -} -foreign import ccall safe "hs_bindgen_3448d03cfd41161a" funptr_args1 :: A -> - FunPtr (IO Unit) -> IO Unit +funptr_args1 = fromBaseForeignType funptr_args1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_92d7386f0a327d25" funptr_args2_base :: BaseForeignType (A -> + FunPtr (IO CInt) -> + IO Unit) +{-| __C declaration:__ @funptr_args2@ + + __defined at:__ @macros\/reparse.h:127:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args2@ +-} +funptr_args2 :: A -> FunPtr (IO CInt) -> IO Unit {-| __C declaration:__ @funptr_args2@ __defined at:__ @macros\/reparse.h:127:6@ @@ -4639,8 +5345,13 @@ foreign import ccall safe "hs_bindgen_3448d03cfd41161a" funptr_args1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args2@ -} -foreign import ccall safe "hs_bindgen_92d7386f0a327d25" funptr_args2 :: A -> - FunPtr (IO CInt) -> IO Unit +funptr_args2 = fromBaseForeignType funptr_args2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2881f594f98043e6" funptr_args3_base :: BaseForeignType (A -> + FunPtr (CInt -> + IO Unit) -> + IO Unit) {-| __C declaration:__ @funptr_args3@ __defined at:__ @macros\/reparse.h:128:6@ @@ -4649,22 +5360,59 @@ foreign import ccall safe "hs_bindgen_92d7386f0a327d25" funptr_args2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args3@ -} -foreign import ccall safe "hs_bindgen_2881f594f98043e6" funptr_args3 :: A -> - FunPtr (CInt -> IO Unit) -> - IO Unit -{-| __C declaration:__ @funptr_args4@ +funptr_args3 :: A -> FunPtr (CInt -> IO Unit) -> IO Unit +{-| __C declaration:__ @funptr_args3@ - __defined at:__ @macros\/reparse.h:129:6@ + __defined at:__ @macros\/reparse.h:128:6@ __exported by:__ @macros\/reparse.h@ - __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args4@ + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args3@ -} -foreign import ccall safe "hs_bindgen_1e85a05df4251f62" funptr_args4 :: A -> - FunPtr (CInt -> - CDouble -> - IO CChar) -> - IO Unit +funptr_args3 = fromBaseForeignType funptr_args3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1e85a05df4251f62" funptr_args4_base :: BaseForeignType (A -> + FunPtr (CInt -> + CDouble -> + IO CChar) -> + IO Unit) +{-| __C declaration:__ @funptr_args4@ + + __defined at:__ @macros\/reparse.h:129:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args4@ +-} +funptr_args4 :: A -> + FunPtr (CInt -> CDouble -> IO CChar) -> IO Unit +{-| __C declaration:__ @funptr_args4@ + + __defined at:__ @macros\/reparse.h:129:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args4@ +-} +funptr_args4 = fromBaseForeignType funptr_args4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ccf4db7511f0d6d6" funptr_args5_base :: BaseForeignType (A -> + FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)) -> + IO Unit) +{-| __C declaration:__ @funptr_args5@ + + __defined at:__ @macros\/reparse.h:130:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args5@ +-} +funptr_args5 :: A -> + FunPtr (CInt -> CDouble -> IO (Ptr CInt)) -> IO Unit {-| __C declaration:__ @funptr_args5@ __defined at:__ @macros\/reparse.h:130:6@ @@ -4673,11 +5421,24 @@ foreign import ccall safe "hs_bindgen_1e85a05df4251f62" funptr_args4 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args5@ -} -foreign import ccall safe "hs_bindgen_ccf4db7511f0d6d6" funptr_args5 :: A -> - FunPtr (CInt -> - CDouble -> - IO (Ptr CInt)) -> - IO Unit +funptr_args5 = fromBaseForeignType funptr_args5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4c756db60673d221" comments1_base :: BaseForeignType (A -> + IO Unit) +{-| Comments in awkward places + + (Prior to language-c we failed to parse there.) + +__C declaration:__ @comments1@ + +__defined at:__ @macros\/reparse.h:144:25@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_comments1@ +-} +comments1 :: A -> IO Unit {-| Comments in awkward places (Prior to language-c we failed to parse there.) @@ -4690,8 +5451,25 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_comments1@ -} -foreign import ccall safe "hs_bindgen_4c756db60673d221" comments1 :: A -> - IO Unit +comments1 = fromBaseForeignType comments1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_278568d7a2a3a4b6" const_prim_before1_base :: BaseForeignType (A -> + CChar -> + IO Unit) +{-| `const` qualifier + + NOTE: These were not parsed correctly prior to the switch to language-c. + +__C declaration:__ @const_prim_before1@ + +__defined at:__ @macros\/reparse.h:179:6@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before1@ +-} +const_prim_before1 :: A -> CChar -> IO Unit {-| `const` qualifier NOTE: These were not parsed correctly prior to the switch to language-c. @@ -4704,8 +5482,21 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before1@ -} -foreign import ccall safe "hs_bindgen_278568d7a2a3a4b6" const_prim_before1 :: A -> - CChar -> IO Unit +const_prim_before1 = fromBaseForeignType const_prim_before1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_87ee56525e5ea20c" const_prim_before2_base :: BaseForeignType (A -> + CSChar -> + IO Unit) +{-| __C declaration:__ @const_prim_before2@ + + __defined at:__ @macros\/reparse.h:180:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before2@ +-} +const_prim_before2 :: A -> CSChar -> IO Unit {-| __C declaration:__ @const_prim_before2@ __defined at:__ @macros\/reparse.h:180:6@ @@ -4714,8 +5505,21 @@ foreign import ccall safe "hs_bindgen_278568d7a2a3a4b6" const_prim_before1 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before2@ -} -foreign import ccall safe "hs_bindgen_87ee56525e5ea20c" const_prim_before2 :: A -> - CSChar -> IO Unit +const_prim_before2 = fromBaseForeignType const_prim_before2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c0b99594235bd99e" const_prim_before3_base :: BaseForeignType (A -> + CUChar -> + IO Unit) +{-| __C declaration:__ @const_prim_before3@ + + __defined at:__ @macros\/reparse.h:181:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before3@ +-} +const_prim_before3 :: A -> CUChar -> IO Unit {-| __C declaration:__ @const_prim_before3@ __defined at:__ @macros\/reparse.h:181:6@ @@ -4724,8 +5528,21 @@ foreign import ccall safe "hs_bindgen_87ee56525e5ea20c" const_prim_before2 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before3@ -} -foreign import ccall safe "hs_bindgen_c0b99594235bd99e" const_prim_before3 :: A -> - CUChar -> IO Unit +const_prim_before3 = fromBaseForeignType const_prim_before3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d718b682f157fc18" const_prim_after1_base :: BaseForeignType (A -> + CChar -> + IO Unit) +{-| __C declaration:__ @const_prim_after1@ + + __defined at:__ @macros\/reparse.h:182:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after1@ +-} +const_prim_after1 :: A -> CChar -> IO Unit {-| __C declaration:__ @const_prim_after1@ __defined at:__ @macros\/reparse.h:182:6@ @@ -4734,8 +5551,21 @@ foreign import ccall safe "hs_bindgen_c0b99594235bd99e" const_prim_before3 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after1@ -} -foreign import ccall safe "hs_bindgen_d718b682f157fc18" const_prim_after1 :: A -> - CChar -> IO Unit +const_prim_after1 = fromBaseForeignType const_prim_after1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f2c5b3d5eca68433" const_prim_after2_base :: BaseForeignType (A -> + CSChar -> + IO Unit) +{-| __C declaration:__ @const_prim_after2@ + + __defined at:__ @macros\/reparse.h:183:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after2@ +-} +const_prim_after2 :: A -> CSChar -> IO Unit {-| __C declaration:__ @const_prim_after2@ __defined at:__ @macros\/reparse.h:183:6@ @@ -4744,8 +5574,21 @@ foreign import ccall safe "hs_bindgen_d718b682f157fc18" const_prim_after1 :: A - __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after2@ -} -foreign import ccall safe "hs_bindgen_f2c5b3d5eca68433" const_prim_after2 :: A -> - CSChar -> IO Unit +const_prim_after2 = fromBaseForeignType const_prim_after2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ae2d994e06667b23" const_prim_after3_base :: BaseForeignType (A -> + CUChar -> + IO Unit) +{-| __C declaration:__ @const_prim_after3@ + + __defined at:__ @macros\/reparse.h:184:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after3@ +-} +const_prim_after3 :: A -> CUChar -> IO Unit {-| __C declaration:__ @const_prim_after3@ __defined at:__ @macros\/reparse.h:184:6@ @@ -4754,8 +5597,21 @@ foreign import ccall safe "hs_bindgen_f2c5b3d5eca68433" const_prim_after2 :: A - __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after3@ -} -foreign import ccall safe "hs_bindgen_ae2d994e06667b23" const_prim_after3 :: A -> - CUChar -> IO Unit +const_prim_after3 = fromBaseForeignType const_prim_after3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6940b58e7f4397a7" const_withoutSign_before1_base :: BaseForeignType (A -> + CFloat -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before1@ + + __defined at:__ @macros\/reparse.h:188:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before1@ +-} +const_withoutSign_before1 :: A -> CFloat -> IO Unit {-| __C declaration:__ @const_withoutSign_before1@ __defined at:__ @macros\/reparse.h:188:6@ @@ -4764,9 +5620,21 @@ foreign import ccall safe "hs_bindgen_ae2d994e06667b23" const_prim_after3 :: A - __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before1@ -} -foreign import ccall safe "hs_bindgen_6940b58e7f4397a7" const_withoutSign_before1 :: A -> - CFloat -> - IO Unit +const_withoutSign_before1 = fromBaseForeignType const_withoutSign_before1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_00b6fe2282e779b1" const_withoutSign_before2_base :: BaseForeignType (A -> + CDouble -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before2@ + + __defined at:__ @macros\/reparse.h:189:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before2@ +-} +const_withoutSign_before2 :: A -> CDouble -> IO Unit {-| __C declaration:__ @const_withoutSign_before2@ __defined at:__ @macros\/reparse.h:189:6@ @@ -4775,9 +5643,21 @@ foreign import ccall safe "hs_bindgen_6940b58e7f4397a7" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before2@ -} -foreign import ccall safe "hs_bindgen_00b6fe2282e779b1" const_withoutSign_before2 :: A -> - CDouble -> - IO Unit +const_withoutSign_before2 = fromBaseForeignType const_withoutSign_before2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6517cc8d39aead93" const_withoutSign_before3_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before3@ + + __defined at:__ @macros\/reparse.h:190:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before3@ +-} +const_withoutSign_before3 :: A -> CBool -> IO Unit {-| __C declaration:__ @const_withoutSign_before3@ __defined at:__ @macros\/reparse.h:190:6@ @@ -4786,16 +5666,23 @@ foreign import ccall safe "hs_bindgen_00b6fe2282e779b1" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before3@ -} -foreign import ccall safe "hs_bindgen_6517cc8d39aead93" const_withoutSign_before3 :: A -> - CBool -> - IO Unit +const_withoutSign_before3 = fromBaseForeignType const_withoutSign_before3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_68c7661e95060488" const_withoutSign_before4_wrapper_base :: BaseForeignType (A -> + Ptr Some_struct -> + IO Unit) +{-| Pointer-based API for 'const_withoutSign_before4' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before4@ +-} +const_withoutSign_before4_wrapper :: A -> + Ptr Some_struct -> IO Unit {-| Pointer-based API for 'const_withoutSign_before4' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before4@ -} -foreign import ccall safe "hs_bindgen_68c7661e95060488" const_withoutSign_before4_wrapper :: A -> - Ptr Some_struct -> - IO Unit +const_withoutSign_before4_wrapper = fromBaseForeignType const_withoutSign_before4_wrapper_base {-| __C declaration:__ @const_withoutSign_before4@ __defined at:__ @macros\/reparse.h:191:6@ @@ -4810,13 +5697,21 @@ const_withoutSign_before4 :: A -> Some_struct -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before4 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_before4_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_42b3b0bf73a7a51a" const_withoutSign_before5_wrapper_base :: BaseForeignType (A -> + Ptr Some_union -> + IO Unit) +{-| Pointer-based API for 'const_withoutSign_before5' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before5@ +-} +const_withoutSign_before5_wrapper :: A -> Ptr Some_union -> IO Unit {-| Pointer-based API for 'const_withoutSign_before5' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before5@ -} -foreign import ccall safe "hs_bindgen_42b3b0bf73a7a51a" const_withoutSign_before5_wrapper :: A -> - Ptr Some_union -> - IO Unit +const_withoutSign_before5_wrapper = fromBaseForeignType const_withoutSign_before5_wrapper_base {-| __C declaration:__ @const_withoutSign_before5@ __defined at:__ @macros\/reparse.h:192:6@ @@ -4831,6 +5726,20 @@ const_withoutSign_before5 :: A -> Some_union -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before5 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_before5_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c4aabe9834aac12f" const_withoutSign_before6_base :: BaseForeignType (A -> + Some_enum -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before6@ + + __defined at:__ @macros\/reparse.h:193:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before6@ +-} +const_withoutSign_before6 :: A -> Some_enum -> IO Unit {-| __C declaration:__ @const_withoutSign_before6@ __defined at:__ @macros\/reparse.h:193:6@ @@ -4839,9 +5748,21 @@ const_withoutSign_before5 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_ __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before6@ -} -foreign import ccall safe "hs_bindgen_c4aabe9834aac12f" const_withoutSign_before6 :: A -> - Some_enum -> - IO Unit +const_withoutSign_before6 = fromBaseForeignType const_withoutSign_before6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_486090a7fb4e34d4" const_withoutSign_before7_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before7@ + + __defined at:__ @macros\/reparse.h:194:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before7@ +-} +const_withoutSign_before7 :: A -> CBool -> IO Unit {-| __C declaration:__ @const_withoutSign_before7@ __defined at:__ @macros\/reparse.h:194:6@ @@ -4850,9 +5771,22 @@ foreign import ccall safe "hs_bindgen_c4aabe9834aac12f" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before7@ -} -foreign import ccall safe "hs_bindgen_486090a7fb4e34d4" const_withoutSign_before7 :: A -> - CBool -> - IO Unit +const_withoutSign_before7 = fromBaseForeignType const_withoutSign_before7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_23fa742b614176dd" const_withoutSign_before8_base :: BaseForeignType (A -> + HsBindgen.Runtime.Prelude.CSize -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before8@ + + __defined at:__ @macros\/reparse.h:195:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before8@ +-} +const_withoutSign_before8 :: A -> + HsBindgen.Runtime.Prelude.CSize -> IO Unit {-| __C declaration:__ @const_withoutSign_before8@ __defined at:__ @macros\/reparse.h:195:6@ @@ -4861,9 +5795,21 @@ foreign import ccall safe "hs_bindgen_486090a7fb4e34d4" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before8@ -} -foreign import ccall safe "hs_bindgen_23fa742b614176dd" const_withoutSign_before8 :: A -> - HsBindgen.Runtime.Prelude.CSize -> - IO Unit +const_withoutSign_before8 = fromBaseForeignType const_withoutSign_before8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0aacd8a5d48f296d" const_withoutSign_after1_base :: BaseForeignType (A -> + CFloat -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after1@ + + __defined at:__ @macros\/reparse.h:197:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after1@ +-} +const_withoutSign_after1 :: A -> CFloat -> IO Unit {-| __C declaration:__ @const_withoutSign_after1@ __defined at:__ @macros\/reparse.h:197:6@ @@ -4872,9 +5818,21 @@ foreign import ccall safe "hs_bindgen_23fa742b614176dd" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after1@ -} -foreign import ccall safe "hs_bindgen_0aacd8a5d48f296d" const_withoutSign_after1 :: A -> - CFloat -> - IO Unit +const_withoutSign_after1 = fromBaseForeignType const_withoutSign_after1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_16ec2102221485b7" const_withoutSign_after2_base :: BaseForeignType (A -> + CDouble -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after2@ + + __defined at:__ @macros\/reparse.h:198:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after2@ +-} +const_withoutSign_after2 :: A -> CDouble -> IO Unit {-| __C declaration:__ @const_withoutSign_after2@ __defined at:__ @macros\/reparse.h:198:6@ @@ -4883,9 +5841,21 @@ foreign import ccall safe "hs_bindgen_0aacd8a5d48f296d" const_withoutSign_after1 __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after2@ -} -foreign import ccall safe "hs_bindgen_16ec2102221485b7" const_withoutSign_after2 :: A -> - CDouble -> - IO Unit +const_withoutSign_after2 = fromBaseForeignType const_withoutSign_after2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9aa934d44ec3790c" const_withoutSign_after3_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after3@ + + __defined at:__ @macros\/reparse.h:199:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after3@ +-} +const_withoutSign_after3 :: A -> CBool -> IO Unit {-| __C declaration:__ @const_withoutSign_after3@ __defined at:__ @macros\/reparse.h:199:6@ @@ -4894,15 +5864,22 @@ foreign import ccall safe "hs_bindgen_16ec2102221485b7" const_withoutSign_after2 __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after3@ -} -foreign import ccall safe "hs_bindgen_9aa934d44ec3790c" const_withoutSign_after3 :: A -> - CBool -> IO Unit +const_withoutSign_after3 = fromBaseForeignType const_withoutSign_after3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_043d2869e29bedcf" const_withoutSign_after4_wrapper_base :: BaseForeignType (A -> + Ptr Some_struct -> + IO Unit) +{-| Pointer-based API for 'const_withoutSign_after4' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after4@ +-} +const_withoutSign_after4_wrapper :: A -> Ptr Some_struct -> IO Unit {-| Pointer-based API for 'const_withoutSign_after4' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after4@ -} -foreign import ccall safe "hs_bindgen_043d2869e29bedcf" const_withoutSign_after4_wrapper :: A -> - Ptr Some_struct -> - IO Unit +const_withoutSign_after4_wrapper = fromBaseForeignType const_withoutSign_after4_wrapper_base {-| __C declaration:__ @const_withoutSign_after4@ __defined at:__ @macros\/reparse.h:200:6@ @@ -4917,13 +5894,21 @@ const_withoutSign_after4 :: A -> Some_struct -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after4 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_after4_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b5f9bca1de9d69de" const_withoutSign_after5_wrapper_base :: BaseForeignType (A -> + Ptr Some_union -> + IO Unit) +{-| Pointer-based API for 'const_withoutSign_after5' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after5@ +-} +const_withoutSign_after5_wrapper :: A -> Ptr Some_union -> IO Unit {-| Pointer-based API for 'const_withoutSign_after5' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after5@ -} -foreign import ccall safe "hs_bindgen_b5f9bca1de9d69de" const_withoutSign_after5_wrapper :: A -> - Ptr Some_union -> - IO Unit +const_withoutSign_after5_wrapper = fromBaseForeignType const_withoutSign_after5_wrapper_base {-| __C declaration:__ @const_withoutSign_after5@ __defined at:__ @macros\/reparse.h:201:6@ @@ -4938,6 +5923,20 @@ const_withoutSign_after5 :: A -> Some_union -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after5 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_after5_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_77d641d518b2504f" const_withoutSign_after6_base :: BaseForeignType (A -> + Some_enum -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after6@ + + __defined at:__ @macros\/reparse.h:202:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after6@ +-} +const_withoutSign_after6 :: A -> Some_enum -> IO Unit {-| __C declaration:__ @const_withoutSign_after6@ __defined at:__ @macros\/reparse.h:202:6@ @@ -4946,9 +5945,21 @@ const_withoutSign_after5 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_a __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after6@ -} -foreign import ccall safe "hs_bindgen_77d641d518b2504f" const_withoutSign_after6 :: A -> - Some_enum -> - IO Unit +const_withoutSign_after6 = fromBaseForeignType const_withoutSign_after6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_691b4f2909140b49" const_withoutSign_after7_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after7@ + + __defined at:__ @macros\/reparse.h:203:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after7@ +-} +const_withoutSign_after7 :: A -> CBool -> IO Unit {-| __C declaration:__ @const_withoutSign_after7@ __defined at:__ @macros\/reparse.h:203:6@ @@ -4957,8 +5968,22 @@ foreign import ccall safe "hs_bindgen_77d641d518b2504f" const_withoutSign_after6 __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after7@ -} -foreign import ccall safe "hs_bindgen_691b4f2909140b49" const_withoutSign_after7 :: A -> - CBool -> IO Unit +const_withoutSign_after7 = fromBaseForeignType const_withoutSign_after7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ae74c8dcdc2ec9eb" const_withoutSign_after8_base :: BaseForeignType (A -> + HsBindgen.Runtime.Prelude.CSize -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after8@ + + __defined at:__ @macros\/reparse.h:204:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after8@ +-} +const_withoutSign_after8 :: A -> + HsBindgen.Runtime.Prelude.CSize -> IO Unit {-| __C declaration:__ @const_withoutSign_after8@ __defined at:__ @macros\/reparse.h:204:6@ @@ -4967,9 +5992,21 @@ foreign import ccall safe "hs_bindgen_691b4f2909140b49" const_withoutSign_after7 __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after8@ -} -foreign import ccall safe "hs_bindgen_ae74c8dcdc2ec9eb" const_withoutSign_after8 :: A -> - HsBindgen.Runtime.Prelude.CSize -> - IO Unit +const_withoutSign_after8 = fromBaseForeignType const_withoutSign_after8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_07606c41eadf9146" const_pointers_args1_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @const_pointers_args1@ + + __defined at:__ @macros\/reparse.h:208:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args1@ +-} +const_pointers_args1 :: A -> Ptr CInt -> IO Unit {-| __C declaration:__ @const_pointers_args1@ __defined at:__ @macros\/reparse.h:208:6@ @@ -4978,8 +6015,12 @@ foreign import ccall safe "hs_bindgen_ae74c8dcdc2ec9eb" const_withoutSign_after8 __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args1@ -} -foreign import ccall safe "hs_bindgen_07606c41eadf9146" const_pointers_args1 :: A -> - Ptr CInt -> IO Unit +const_pointers_args1 = fromBaseForeignType const_pointers_args1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3836769f3a3416ac" const_pointers_args2_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) {-| __C declaration:__ @const_pointers_args2@ __defined at:__ @macros\/reparse.h:209:6@ @@ -4988,38 +6029,98 @@ foreign import ccall safe "hs_bindgen_07606c41eadf9146" const_pointers_args1 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args2@ -} -foreign import ccall safe "hs_bindgen_3836769f3a3416ac" const_pointers_args2 :: A -> - Ptr CInt -> IO Unit -{-| __C declaration:__ @const_pointers_args3@ +const_pointers_args2 :: A -> Ptr CInt -> IO Unit +{-| __C declaration:__ @const_pointers_args2@ - __defined at:__ @macros\/reparse.h:210:6@ + __defined at:__ @macros\/reparse.h:209:6@ __exported by:__ @macros\/reparse.h@ - __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args3@ + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args2@ -} -foreign import ccall safe "hs_bindgen_12f19ea593aefd3f" const_pointers_args3 :: A -> - Ptr CInt -> IO Unit -{-| __C declaration:__ @const_pointers_args4@ +const_pointers_args2 = fromBaseForeignType const_pointers_args2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_12f19ea593aefd3f" const_pointers_args3_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @const_pointers_args3@ - __defined at:__ @macros\/reparse.h:211:6@ + __defined at:__ @macros\/reparse.h:210:6@ __exported by:__ @macros\/reparse.h@ - __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args4@ + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args3@ -} -foreign import ccall safe "hs_bindgen_5a50e98897696d57" const_pointers_args4 :: A -> - Ptr CInt -> IO Unit -{-| __C declaration:__ @const_pointers_args5@ +const_pointers_args3 :: A -> Ptr CInt -> IO Unit +{-| __C declaration:__ @const_pointers_args3@ - __defined at:__ @macros\/reparse.h:212:6@ + __defined at:__ @macros\/reparse.h:210:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args3@ +-} +const_pointers_args3 = fromBaseForeignType const_pointers_args3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5a50e98897696d57" const_pointers_args4_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @const_pointers_args4@ + + __defined at:__ @macros\/reparse.h:211:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args4@ +-} +const_pointers_args4 :: A -> Ptr CInt -> IO Unit +{-| __C declaration:__ @const_pointers_args4@ + + __defined at:__ @macros\/reparse.h:211:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args4@ +-} +const_pointers_args4 = fromBaseForeignType const_pointers_args4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_666701f7cb61bd15" const_pointers_args5_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @const_pointers_args5@ + + __defined at:__ @macros\/reparse.h:212:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args5@ +-} +const_pointers_args5 :: A -> Ptr CInt -> IO Unit +{-| __C declaration:__ @const_pointers_args5@ + + __defined at:__ @macros\/reparse.h:212:6@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args5@ -} -foreign import ccall safe "hs_bindgen_666701f7cb61bd15" const_pointers_args5 :: A -> - Ptr CInt -> IO Unit +const_pointers_args5 = fromBaseForeignType const_pointers_args5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b94fbc3dfd285563" const_pointers_ret1_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @const_pointers_ret1@ + + __defined at:__ @macros\/reparse.h:214:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret1@ +-} +const_pointers_ret1 :: A -> IO (Ptr CInt) {-| __C declaration:__ @const_pointers_ret1@ __defined at:__ @macros\/reparse.h:214:19@ @@ -5028,8 +6129,20 @@ foreign import ccall safe "hs_bindgen_666701f7cb61bd15" const_pointers_args5 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret1@ -} -foreign import ccall safe "hs_bindgen_b94fbc3dfd285563" const_pointers_ret1 :: A -> - IO (Ptr CInt) +const_pointers_ret1 = fromBaseForeignType const_pointers_ret1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_33e2960e26b79450" const_pointers_ret2_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @const_pointers_ret2@ + + __defined at:__ @macros\/reparse.h:215:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret2@ +-} +const_pointers_ret2 :: A -> IO (Ptr CInt) {-| __C declaration:__ @const_pointers_ret2@ __defined at:__ @macros\/reparse.h:215:19@ @@ -5038,8 +6151,20 @@ foreign import ccall safe "hs_bindgen_b94fbc3dfd285563" const_pointers_ret1 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret2@ -} -foreign import ccall safe "hs_bindgen_33e2960e26b79450" const_pointers_ret2 :: A -> - IO (Ptr CInt) +const_pointers_ret2 = fromBaseForeignType const_pointers_ret2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_50c6e2fe4f3fb777" const_pointers_ret3_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @const_pointers_ret3@ + + __defined at:__ @macros\/reparse.h:216:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret3@ +-} +const_pointers_ret3 :: A -> IO (Ptr CInt) {-| __C declaration:__ @const_pointers_ret3@ __defined at:__ @macros\/reparse.h:216:19@ @@ -5048,8 +6173,11 @@ foreign import ccall safe "hs_bindgen_33e2960e26b79450" const_pointers_ret2 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret3@ -} -foreign import ccall safe "hs_bindgen_50c6e2fe4f3fb777" const_pointers_ret3 :: A -> - IO (Ptr CInt) +const_pointers_ret3 = fromBaseForeignType const_pointers_ret3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_edc014695d896c8d" const_pointers_ret4_base :: BaseForeignType (A -> + IO (Ptr CInt)) {-| __C declaration:__ @const_pointers_ret4@ __defined at:__ @macros\/reparse.h:217:19@ @@ -5058,8 +6186,29 @@ foreign import ccall safe "hs_bindgen_50c6e2fe4f3fb777" const_pointers_ret3 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret4@ -} -foreign import ccall safe "hs_bindgen_edc014695d896c8d" const_pointers_ret4 :: A -> - IO (Ptr CInt) +const_pointers_ret4 :: A -> IO (Ptr CInt) +{-| __C declaration:__ @const_pointers_ret4@ + + __defined at:__ @macros\/reparse.h:217:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret4@ +-} +const_pointers_ret4 = fromBaseForeignType const_pointers_ret4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6d3308cc5847f033" const_pointers_ret5_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @const_pointers_ret5@ + + __defined at:__ @macros\/reparse.h:218:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret5@ +-} +const_pointers_ret5 :: A -> IO (Ptr CInt) {-| __C declaration:__ @const_pointers_ret5@ __defined at:__ @macros\/reparse.h:218:19@ @@ -5068,14 +6217,21 @@ foreign import ccall safe "hs_bindgen_edc014695d896c8d" const_pointers_ret4 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret5@ -} -foreign import ccall safe "hs_bindgen_6d3308cc5847f033" const_pointers_ret5 :: A -> - IO (Ptr CInt) +const_pointers_ret5 = fromBaseForeignType const_pointers_ret5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_678576320923a4d1" const_array_elem1_wrapper_base :: BaseForeignType (Ptr A -> + IO Unit) {-| Pointer-based API for 'const_array_elem1' __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem1@ -} -foreign import ccall safe "hs_bindgen_678576320923a4d1" const_array_elem1_wrapper :: Ptr A -> - IO Unit +const_array_elem1_wrapper :: Ptr A -> IO Unit +{-| Pointer-based API for 'const_array_elem1' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem1@ +-} +const_array_elem1_wrapper = fromBaseForeignType const_array_elem1_wrapper_base {-| __C declaration:__ @const_array_elem1@ __defined at:__ @macros\/reparse.h:246:6@ @@ -5090,6 +6246,19 @@ const_array_elem1 :: IncompleteArray A -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_array_elem1 = \x_0 -> withPtr x_0 (\ptr_1 -> const_array_elem1_wrapper ptr_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b317941dde4eeff2" const_array_elem2_base :: BaseForeignType (Ptr (Ptr A) -> + IO Unit) +{-| __C declaration:__ @const_array_elem2@ + + __defined at:__ @macros\/reparse.h:247:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem2@ +-} +const_array_elem2 :: Ptr (Ptr A) -> IO Unit {-| __C declaration:__ @const_array_elem2@ __defined at:__ @macros\/reparse.h:247:6@ @@ -5098,14 +6267,21 @@ const_array_elem1 = \x_0 -> withPtr x_0 (\ptr_1 -> const_array_elem1_wrapper ptr __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem2@ -} -foreign import ccall safe "hs_bindgen_b317941dde4eeff2" const_array_elem2 :: Ptr (Ptr A) -> - IO Unit +const_array_elem2 = fromBaseForeignType const_array_elem2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_707e602e6beb1bb6" const_array_elem3_wrapper_base :: BaseForeignType (Ptr (Ptr A) -> + IO Unit) {-| Pointer-based API for 'const_array_elem3' __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem3@ -} -foreign import ccall safe "hs_bindgen_707e602e6beb1bb6" const_array_elem3_wrapper :: Ptr (Ptr A) -> - IO Unit +const_array_elem3_wrapper :: Ptr (Ptr A) -> IO Unit +{-| Pointer-based API for 'const_array_elem3' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem3@ +-} +const_array_elem3_wrapper = fromBaseForeignType const_array_elem3_wrapper_base {-| __C declaration:__ @const_array_elem3@ __defined at:__ @macros\/reparse.h:248:6@ @@ -5120,6 +6296,20 @@ const_array_elem3 :: IncompleteArray (Ptr A) -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_array_elem3 = \x_0 -> withPtr x_0 (\ptr_1 -> const_array_elem3_wrapper ptr_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_93fecb4eb766c262" noParams1_base :: BaseForeignType (IO A) +{-| Other examples we reparsed /incorrectly/ before language-c + +__C declaration:__ @noParams1@ + +__defined at:__ @macros\/reparse.h:256:3@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_noParams1@ +-} +noParams1 :: IO A {-| Other examples we reparsed /incorrectly/ before language-c __C declaration:__ @noParams1@ @@ -5130,7 +6320,10 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_noParams1@ -} -foreign import ccall safe "hs_bindgen_93fecb4eb766c262" noParams1 :: IO A +noParams1 = fromBaseForeignType noParams1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4350965157c891f5" noParams2_base :: BaseForeignType (IO A) {-| __C declaration:__ @noParams2@ __defined at:__ @macros\/reparse.h:257:3@ @@ -5139,7 +6332,30 @@ foreign import ccall safe "hs_bindgen_93fecb4eb766c262" noParams1 :: IO A __unique:__ @test_macrosreparse_Example_Unsafe_noParams2@ -} -foreign import ccall safe "hs_bindgen_4350965157c891f5" noParams2 :: IO A +noParams2 :: IO A +{-| __C declaration:__ @noParams2@ + + __defined at:__ @macros\/reparse.h:257:3@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_noParams2@ +-} +noParams2 = fromBaseForeignType noParams2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c4f59272a2b1c3b5" noParams3_base :: BaseForeignType (A -> + FunPtr (IO CInt) -> + IO Unit) +{-| __C declaration:__ @noParams3@ + + __defined at:__ @macros\/reparse.h:258:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_noParams3@ +-} +noParams3 :: A -> FunPtr (IO CInt) -> IO Unit {-| __C declaration:__ @noParams3@ __defined at:__ @macros\/reparse.h:258:6@ @@ -5148,8 +6364,20 @@ foreign import ccall safe "hs_bindgen_4350965157c891f5" noParams2 :: IO A __unique:__ @test_macrosreparse_Example_Unsafe_noParams3@ -} -foreign import ccall safe "hs_bindgen_c4f59272a2b1c3b5" noParams3 :: A -> - FunPtr (IO CInt) -> IO Unit +noParams3 = fromBaseForeignType noParams3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_387a04c01e23c320" funptr_ret1_base :: BaseForeignType (A -> + IO (FunPtr (IO Unit))) +{-| __C declaration:__ @funptr_ret1@ + + __defined at:__ @macros\/reparse.h:262:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret1@ +-} +funptr_ret1 :: A -> IO (FunPtr (IO Unit)) {-| __C declaration:__ @funptr_ret1@ __defined at:__ @macros\/reparse.h:262:8@ @@ -5158,8 +6386,20 @@ foreign import ccall safe "hs_bindgen_c4f59272a2b1c3b5" noParams3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret1@ -} -foreign import ccall safe "hs_bindgen_387a04c01e23c320" funptr_ret1 :: A -> - IO (FunPtr (IO Unit)) +funptr_ret1 = fromBaseForeignType funptr_ret1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6f0c14cd3478dc19" funptr_ret2_base :: BaseForeignType (A -> + IO (FunPtr (IO CInt))) +{-| __C declaration:__ @funptr_ret2@ + + __defined at:__ @macros\/reparse.h:263:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret2@ +-} +funptr_ret2 :: A -> IO (FunPtr (IO CInt)) {-| __C declaration:__ @funptr_ret2@ __defined at:__ @macros\/reparse.h:263:8@ @@ -5168,8 +6408,21 @@ foreign import ccall safe "hs_bindgen_387a04c01e23c320" funptr_ret1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret2@ -} -foreign import ccall safe "hs_bindgen_6f0c14cd3478dc19" funptr_ret2 :: A -> - IO (FunPtr (IO CInt)) +funptr_ret2 = fromBaseForeignType funptr_ret2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_08e8661d277cf7be" funptr_ret3_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + IO Unit))) +{-| __C declaration:__ @funptr_ret3@ + + __defined at:__ @macros\/reparse.h:264:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret3@ +-} +funptr_ret3 :: A -> IO (FunPtr (CInt -> IO Unit)) {-| __C declaration:__ @funptr_ret3@ __defined at:__ @macros\/reparse.h:264:8@ @@ -5178,8 +6431,22 @@ foreign import ccall safe "hs_bindgen_6f0c14cd3478dc19" funptr_ret2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret3@ -} -foreign import ccall safe "hs_bindgen_08e8661d277cf7be" funptr_ret3 :: A -> - IO (FunPtr (CInt -> IO Unit)) +funptr_ret3 = fromBaseForeignType funptr_ret3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_609b5d953b68da92" funptr_ret4_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO CChar))) +{-| __C declaration:__ @funptr_ret4@ + + __defined at:__ @macros\/reparse.h:265:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret4@ +-} +funptr_ret4 :: A -> IO (FunPtr (CInt -> CDouble -> IO CChar)) {-| __C declaration:__ @funptr_ret4@ __defined at:__ @macros\/reparse.h:265:8@ @@ -5188,10 +6455,22 @@ foreign import ccall safe "hs_bindgen_08e8661d277cf7be" funptr_ret3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret4@ -} -foreign import ccall safe "hs_bindgen_609b5d953b68da92" funptr_ret4 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO CChar)) +funptr_ret4 = fromBaseForeignType funptr_ret4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_13e6ae43abf40aee" funptr_ret5_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret5@ + + __defined at:__ @macros\/reparse.h:269:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret5@ +-} +funptr_ret5 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret5@ __defined at:__ @macros\/reparse.h:269:20@ @@ -5200,10 +6479,22 @@ foreign import ccall safe "hs_bindgen_609b5d953b68da92" funptr_ret4 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret5@ -} -foreign import ccall safe "hs_bindgen_13e6ae43abf40aee" funptr_ret5 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret5 = fromBaseForeignType funptr_ret5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a4a3a86f28ca6299" funptr_ret6_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret6@ + + __defined at:__ @macros\/reparse.h:270:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret6@ +-} +funptr_ret6 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret6@ __defined at:__ @macros\/reparse.h:270:20@ @@ -5212,10 +6503,22 @@ foreign import ccall safe "hs_bindgen_13e6ae43abf40aee" funptr_ret5 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret6@ -} -foreign import ccall safe "hs_bindgen_a4a3a86f28ca6299" funptr_ret6 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret6 = fromBaseForeignType funptr_ret6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eae9dff04c88d00b" funptr_ret7_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret7@ + + __defined at:__ @macros\/reparse.h:271:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret7@ +-} +funptr_ret7 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret7@ __defined at:__ @macros\/reparse.h:271:20@ @@ -5224,10 +6527,13 @@ foreign import ccall safe "hs_bindgen_a4a3a86f28ca6299" funptr_ret6 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret7@ -} -foreign import ccall safe "hs_bindgen_eae9dff04c88d00b" funptr_ret7 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret7 = fromBaseForeignType funptr_ret7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_894457d90a2fc8db" funptr_ret8_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) {-| __C declaration:__ @funptr_ret8@ __defined at:__ @macros\/reparse.h:272:20@ @@ -5236,10 +6542,31 @@ foreign import ccall safe "hs_bindgen_eae9dff04c88d00b" funptr_ret7 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret8@ -} -foreign import ccall safe "hs_bindgen_894457d90a2fc8db" funptr_ret8 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret8 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) +{-| __C declaration:__ @funptr_ret8@ + + __defined at:__ @macros\/reparse.h:272:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret8@ +-} +funptr_ret8 = fromBaseForeignType funptr_ret8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c893eb15ad9bc68c" funptr_ret9_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret9@ + + __defined at:__ @macros\/reparse.h:273:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret9@ +-} +funptr_ret9 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret9@ __defined at:__ @macros\/reparse.h:273:20@ @@ -5248,10 +6575,22 @@ foreign import ccall safe "hs_bindgen_894457d90a2fc8db" funptr_ret8 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret9@ -} -foreign import ccall safe "hs_bindgen_c893eb15ad9bc68c" funptr_ret9 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret9 = fromBaseForeignType funptr_ret9_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d96c258298a44b28" funptr_ret10_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret10@ + + __defined at:__ @macros\/reparse.h:274:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret10@ +-} +funptr_ret10 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret10@ __defined at:__ @macros\/reparse.h:274:20@ @@ -5260,10 +6599,12 @@ foreign import ccall safe "hs_bindgen_c893eb15ad9bc68c" funptr_ret9 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret10@ -} -foreign import ccall safe "hs_bindgen_d96c258298a44b28" funptr_ret10 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret10 = fromBaseForeignType funptr_ret10_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c1716e300ba327c7" args_char1_base :: BaseForeignType (A -> + CChar -> + IO Unit) {-| Function declarations __C declaration:__ @args_char1@ @@ -5274,8 +6615,32 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_args_char1@ -} -foreign import ccall safe "hs_bindgen_c1716e300ba327c7" args_char1 :: A -> - CChar -> IO Unit +args_char1 :: A -> CChar -> IO Unit +{-| Function declarations + +__C declaration:__ @args_char1@ + +__defined at:__ @macros\/reparse.h:17:6@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_args_char1@ +-} +args_char1 = fromBaseForeignType args_char1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3ef14607a6187aaa" args_char2_base :: BaseForeignType (A -> + CSChar -> + IO Unit) +{-| __C declaration:__ @args_char2@ + + __defined at:__ @macros\/reparse.h:18:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_char2@ +-} +args_char2 :: A -> CSChar -> IO Unit {-| __C declaration:__ @args_char2@ __defined at:__ @macros\/reparse.h:18:6@ @@ -5284,8 +6649,12 @@ foreign import ccall safe "hs_bindgen_c1716e300ba327c7" args_char1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_char2@ -} -foreign import ccall safe "hs_bindgen_3ef14607a6187aaa" args_char2 :: A -> - CSChar -> IO Unit +args_char2 = fromBaseForeignType args_char2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5b0a626f64912f9d" args_char3_base :: BaseForeignType (A -> + CUChar -> + IO Unit) {-| __C declaration:__ @args_char3@ __defined at:__ @macros\/reparse.h:19:6@ @@ -5294,8 +6663,30 @@ foreign import ccall safe "hs_bindgen_3ef14607a6187aaa" args_char2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_char3@ -} -foreign import ccall safe "hs_bindgen_5b0a626f64912f9d" args_char3 :: A -> - CUChar -> IO Unit +args_char3 :: A -> CUChar -> IO Unit +{-| __C declaration:__ @args_char3@ + + __defined at:__ @macros\/reparse.h:19:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_char3@ +-} +args_char3 = fromBaseForeignType args_char3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_36e4501239085bc1" args_short1_base :: BaseForeignType (A -> + CShort -> + IO Unit) +{-| __C declaration:__ @args_short1@ + + __defined at:__ @macros\/reparse.h:21:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_short1@ +-} +args_short1 :: A -> CShort -> IO Unit {-| __C declaration:__ @args_short1@ __defined at:__ @macros\/reparse.h:21:6@ @@ -5304,8 +6695,21 @@ foreign import ccall safe "hs_bindgen_5b0a626f64912f9d" args_char3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_short1@ -} -foreign import ccall safe "hs_bindgen_36e4501239085bc1" args_short1 :: A -> - CShort -> IO Unit +args_short1 = fromBaseForeignType args_short1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a187e0233daeb237" args_short2_base :: BaseForeignType (A -> + CShort -> + IO Unit) +{-| __C declaration:__ @args_short2@ + + __defined at:__ @macros\/reparse.h:22:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_short2@ +-} +args_short2 :: A -> CShort -> IO Unit {-| __C declaration:__ @args_short2@ __defined at:__ @macros\/reparse.h:22:6@ @@ -5314,8 +6718,21 @@ foreign import ccall safe "hs_bindgen_36e4501239085bc1" args_short1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_short2@ -} -foreign import ccall safe "hs_bindgen_a187e0233daeb237" args_short2 :: A -> - CShort -> IO Unit +args_short2 = fromBaseForeignType args_short2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2460adeff61561ce" args_short3_base :: BaseForeignType (A -> + CUShort -> + IO Unit) +{-| __C declaration:__ @args_short3@ + + __defined at:__ @macros\/reparse.h:23:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_short3@ +-} +args_short3 :: A -> CUShort -> IO Unit {-| __C declaration:__ @args_short3@ __defined at:__ @macros\/reparse.h:23:6@ @@ -5324,8 +6741,21 @@ foreign import ccall safe "hs_bindgen_a187e0233daeb237" args_short2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_short3@ -} -foreign import ccall safe "hs_bindgen_2460adeff61561ce" args_short3 :: A -> - CUShort -> IO Unit +args_short3 = fromBaseForeignType args_short3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4f13ab06db79b7f2" args_int1_base :: BaseForeignType (A -> + CInt -> + IO Unit) +{-| __C declaration:__ @args_int1@ + + __defined at:__ @macros\/reparse.h:25:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_int1@ +-} +args_int1 :: A -> CInt -> IO Unit {-| __C declaration:__ @args_int1@ __defined at:__ @macros\/reparse.h:25:6@ @@ -5334,8 +6764,21 @@ foreign import ccall safe "hs_bindgen_2460adeff61561ce" args_short3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_int1@ -} -foreign import ccall safe "hs_bindgen_4f13ab06db79b7f2" args_int1 :: A -> - CInt -> IO Unit +args_int1 = fromBaseForeignType args_int1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f1657d18f6f8a1ed" args_int2_base :: BaseForeignType (A -> + CInt -> + IO Unit) +{-| __C declaration:__ @args_int2@ + + __defined at:__ @macros\/reparse.h:26:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_int2@ +-} +args_int2 :: A -> CInt -> IO Unit {-| __C declaration:__ @args_int2@ __defined at:__ @macros\/reparse.h:26:6@ @@ -5344,8 +6787,21 @@ foreign import ccall safe "hs_bindgen_4f13ab06db79b7f2" args_int1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_int2@ -} -foreign import ccall safe "hs_bindgen_f1657d18f6f8a1ed" args_int2 :: A -> - CInt -> IO Unit +args_int2 = fromBaseForeignType args_int2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9ac58b8eb806be42" args_int3_base :: BaseForeignType (A -> + CUInt -> + IO Unit) +{-| __C declaration:__ @args_int3@ + + __defined at:__ @macros\/reparse.h:27:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_int3@ +-} +args_int3 :: A -> CUInt -> IO Unit {-| __C declaration:__ @args_int3@ __defined at:__ @macros\/reparse.h:27:6@ @@ -5354,8 +6810,21 @@ foreign import ccall safe "hs_bindgen_f1657d18f6f8a1ed" args_int2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_int3@ -} -foreign import ccall safe "hs_bindgen_9ac58b8eb806be42" args_int3 :: A -> - CUInt -> IO Unit +args_int3 = fromBaseForeignType args_int3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f73c59fe22a9870e" args_long1_base :: BaseForeignType (A -> + CLong -> + IO Unit) +{-| __C declaration:__ @args_long1@ + + __defined at:__ @macros\/reparse.h:29:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_long1@ +-} +args_long1 :: A -> CLong -> IO Unit {-| __C declaration:__ @args_long1@ __defined at:__ @macros\/reparse.h:29:6@ @@ -5364,8 +6833,21 @@ foreign import ccall safe "hs_bindgen_9ac58b8eb806be42" args_int3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_long1@ -} -foreign import ccall safe "hs_bindgen_f73c59fe22a9870e" args_long1 :: A -> - CLong -> IO Unit +args_long1 = fromBaseForeignType args_long1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_84a824853fc83077" args_long2_base :: BaseForeignType (A -> + CLong -> + IO Unit) +{-| __C declaration:__ @args_long2@ + + __defined at:__ @macros\/reparse.h:30:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_long2@ +-} +args_long2 :: A -> CLong -> IO Unit {-| __C declaration:__ @args_long2@ __defined at:__ @macros\/reparse.h:30:6@ @@ -5374,8 +6856,21 @@ foreign import ccall safe "hs_bindgen_f73c59fe22a9870e" args_long1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_long2@ -} -foreign import ccall safe "hs_bindgen_84a824853fc83077" args_long2 :: A -> - CLong -> IO Unit +args_long2 = fromBaseForeignType args_long2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c4c1a08ddf9cd5bc" args_long3_base :: BaseForeignType (A -> + CULong -> + IO Unit) +{-| __C declaration:__ @args_long3@ + + __defined at:__ @macros\/reparse.h:31:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_long3@ +-} +args_long3 :: A -> CULong -> IO Unit {-| __C declaration:__ @args_long3@ __defined at:__ @macros\/reparse.h:31:6@ @@ -5384,8 +6879,21 @@ foreign import ccall safe "hs_bindgen_84a824853fc83077" args_long2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_long3@ -} -foreign import ccall safe "hs_bindgen_c4c1a08ddf9cd5bc" args_long3 :: A -> - CULong -> IO Unit +args_long3 = fromBaseForeignType args_long3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_58a6b5f118525c6c" args_float_base :: BaseForeignType (A -> + CFloat -> + IO Unit) +{-| __C declaration:__ @args_float@ + + __defined at:__ @macros\/reparse.h:33:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_float@ +-} +args_float :: A -> CFloat -> IO Unit {-| __C declaration:__ @args_float@ __defined at:__ @macros\/reparse.h:33:6@ @@ -5394,8 +6902,21 @@ foreign import ccall safe "hs_bindgen_c4c1a08ddf9cd5bc" args_long3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_float@ -} -foreign import ccall safe "hs_bindgen_58a6b5f118525c6c" args_float :: A -> - CFloat -> IO Unit +args_float = fromBaseForeignType args_float_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ffc58625c3a51d8f" args_double_base :: BaseForeignType (A -> + CDouble -> + IO Unit) +{-| __C declaration:__ @args_double@ + + __defined at:__ @macros\/reparse.h:34:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_double@ +-} +args_double :: A -> CDouble -> IO Unit {-| __C declaration:__ @args_double@ __defined at:__ @macros\/reparse.h:34:6@ @@ -5404,8 +6925,12 @@ foreign import ccall safe "hs_bindgen_58a6b5f118525c6c" args_float :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_double@ -} -foreign import ccall safe "hs_bindgen_ffc58625c3a51d8f" args_double :: A -> - CDouble -> IO Unit +args_double = fromBaseForeignType args_double_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_51fb2da1d100c9a7" args_bool1_base :: BaseForeignType (A -> + CBool -> + IO Unit) {-| __C declaration:__ @args_bool1@ __defined at:__ @macros\/reparse.h:35:6@ @@ -5414,15 +6939,31 @@ foreign import ccall safe "hs_bindgen_ffc58625c3a51d8f" args_double :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_bool1@ -} -foreign import ccall safe "hs_bindgen_51fb2da1d100c9a7" args_bool1 :: A -> - CBool -> IO Unit +args_bool1 :: A -> CBool -> IO Unit +{-| __C declaration:__ @args_bool1@ + + __defined at:__ @macros\/reparse.h:35:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_bool1@ +-} +args_bool1 = fromBaseForeignType args_bool1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b2d19f91a7b9f7d3" args_struct_wrapper_base :: BaseForeignType (A -> + Ptr Some_struct -> + IO Unit) +{-| Pointer-based API for 'args_struct' + +__unique:__ @test_macrosreparse_Example_Unsafe_args_struct@ +-} +args_struct_wrapper :: A -> Ptr Some_struct -> IO Unit {-| Pointer-based API for 'args_struct' __unique:__ @test_macrosreparse_Example_Unsafe_args_struct@ -} -foreign import ccall safe "hs_bindgen_b2d19f91a7b9f7d3" args_struct_wrapper :: A -> - Ptr Some_struct -> - IO Unit +args_struct_wrapper = fromBaseForeignType args_struct_wrapper_base {-| __C declaration:__ @args_struct@ __defined at:__ @macros\/reparse.h:37:6@ @@ -5437,13 +6978,21 @@ args_struct :: A -> Some_struct -> IO Unit __exported by:__ @macros\/reparse.h@ -} args_struct = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_struct_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bc74164a05d282c7" args_union_wrapper_base :: BaseForeignType (A -> + Ptr Some_union -> + IO Unit) +{-| Pointer-based API for 'args_union' + +__unique:__ @test_macrosreparse_Example_Unsafe_args_union@ +-} +args_union_wrapper :: A -> Ptr Some_union -> IO Unit {-| Pointer-based API for 'args_union' __unique:__ @test_macrosreparse_Example_Unsafe_args_union@ -} -foreign import ccall safe "hs_bindgen_bc74164a05d282c7" args_union_wrapper :: A -> - Ptr Some_union -> - IO Unit +args_union_wrapper = fromBaseForeignType args_union_wrapper_base {-| __C declaration:__ @args_union@ __defined at:__ @macros\/reparse.h:38:6@ @@ -5458,6 +7007,11 @@ args_union :: A -> Some_union -> IO Unit __exported by:__ @macros\/reparse.h@ -} args_union = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_union_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_69f08c1d9f5e590e" args_enum_base :: BaseForeignType (A -> + Some_enum -> + IO Unit) {-| __C declaration:__ @args_enum@ __defined at:__ @macros\/reparse.h:39:6@ @@ -5466,8 +7020,30 @@ args_union = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_union_wrapper x_0 y_2) __unique:__ @test_macrosreparse_Example_Unsafe_args_enum@ -} -foreign import ccall safe "hs_bindgen_69f08c1d9f5e590e" args_enum :: A -> - Some_enum -> IO Unit +args_enum :: A -> Some_enum -> IO Unit +{-| __C declaration:__ @args_enum@ + + __defined at:__ @macros\/reparse.h:39:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_enum@ +-} +args_enum = fromBaseForeignType args_enum_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_785b005f35d4d7ec" args_pointer1_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @args_pointer1@ + + __defined at:__ @macros\/reparse.h:41:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer1@ +-} +args_pointer1 :: A -> Ptr CInt -> IO Unit {-| __C declaration:__ @args_pointer1@ __defined at:__ @macros\/reparse.h:41:6@ @@ -5476,8 +7052,21 @@ foreign import ccall safe "hs_bindgen_69f08c1d9f5e590e" args_enum :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer1@ -} -foreign import ccall safe "hs_bindgen_785b005f35d4d7ec" args_pointer1 :: A -> - Ptr CInt -> IO Unit +args_pointer1 = fromBaseForeignType args_pointer1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_edc45a1b9750dcd3" args_pointer2_base :: BaseForeignType (A -> + Ptr (Ptr CInt) -> + IO Unit) +{-| __C declaration:__ @args_pointer2@ + + __defined at:__ @macros\/reparse.h:42:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer2@ +-} +args_pointer2 :: A -> Ptr (Ptr CInt) -> IO Unit {-| __C declaration:__ @args_pointer2@ __defined at:__ @macros\/reparse.h:42:6@ @@ -5486,8 +7075,21 @@ foreign import ccall safe "hs_bindgen_785b005f35d4d7ec" args_pointer1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer2@ -} -foreign import ccall safe "hs_bindgen_edc45a1b9750dcd3" args_pointer2 :: A -> - Ptr (Ptr CInt) -> IO Unit +args_pointer2 = fromBaseForeignType args_pointer2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_102895862f35ca35" args_pointer3_base :: BaseForeignType (A -> + Ptr Void -> + IO Unit) +{-| __C declaration:__ @args_pointer3@ + + __defined at:__ @macros\/reparse.h:43:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer3@ +-} +args_pointer3 :: A -> Ptr Void -> IO Unit {-| __C declaration:__ @args_pointer3@ __defined at:__ @macros\/reparse.h:43:6@ @@ -5496,8 +7098,19 @@ foreign import ccall safe "hs_bindgen_edc45a1b9750dcd3" args_pointer2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_args_pointer3@ -} -foreign import ccall safe "hs_bindgen_102895862f35ca35" args_pointer3 :: A -> - Ptr Void -> IO Unit +args_pointer3 = fromBaseForeignType args_pointer3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_78f9ea765accb501" ret_A_base :: BaseForeignType (IO A) +{-| __C declaration:__ @ret_A@ + + __defined at:__ @macros\/reparse.h:47:3@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_A@ +-} +ret_A :: IO A {-| __C declaration:__ @ret_A@ __defined at:__ @macros\/reparse.h:47:3@ @@ -5506,7 +7119,20 @@ foreign import ccall safe "hs_bindgen_102895862f35ca35" args_pointer3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_A@ -} -foreign import ccall safe "hs_bindgen_78f9ea765accb501" ret_A :: IO A +ret_A = fromBaseForeignType ret_A_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e1e99ef9fc54a288" ret_char1_base :: BaseForeignType (A -> + IO CChar) +{-| __C declaration:__ @ret_char1@ + + __defined at:__ @macros\/reparse.h:49:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_char1@ +-} +ret_char1 :: A -> IO CChar {-| __C declaration:__ @ret_char1@ __defined at:__ @macros\/reparse.h:49:20@ @@ -5515,8 +7141,20 @@ foreign import ccall safe "hs_bindgen_78f9ea765accb501" ret_A :: IO A __unique:__ @test_macrosreparse_Example_Unsafe_ret_char1@ -} -foreign import ccall safe "hs_bindgen_e1e99ef9fc54a288" ret_char1 :: A -> - IO CChar +ret_char1 = fromBaseForeignType ret_char1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f6217639a7e142d3" ret_char2_base :: BaseForeignType (A -> + IO CSChar) +{-| __C declaration:__ @ret_char2@ + + __defined at:__ @macros\/reparse.h:50:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_char2@ +-} +ret_char2 :: A -> IO CSChar {-| __C declaration:__ @ret_char2@ __defined at:__ @macros\/reparse.h:50:20@ @@ -5525,8 +7163,20 @@ foreign import ccall safe "hs_bindgen_e1e99ef9fc54a288" ret_char1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_char2@ -} -foreign import ccall safe "hs_bindgen_f6217639a7e142d3" ret_char2 :: A -> - IO CSChar +ret_char2 = fromBaseForeignType ret_char2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_759b6cec946323f4" ret_char3_base :: BaseForeignType (A -> + IO CUChar) +{-| __C declaration:__ @ret_char3@ + + __defined at:__ @macros\/reparse.h:51:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_char3@ +-} +ret_char3 :: A -> IO CUChar {-| __C declaration:__ @ret_char3@ __defined at:__ @macros\/reparse.h:51:20@ @@ -5535,8 +7185,20 @@ foreign import ccall safe "hs_bindgen_f6217639a7e142d3" ret_char2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_char3@ -} -foreign import ccall safe "hs_bindgen_759b6cec946323f4" ret_char3 :: A -> - IO CUChar +ret_char3 = fromBaseForeignType ret_char3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bf062c8332405f82" ret_short1_base :: BaseForeignType (A -> + IO CShort) +{-| __C declaration:__ @ret_short1@ + + __defined at:__ @macros\/reparse.h:53:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_short1@ +-} +ret_short1 :: A -> IO CShort {-| __C declaration:__ @ret_short1@ __defined at:__ @macros\/reparse.h:53:20@ @@ -5545,8 +7207,20 @@ foreign import ccall safe "hs_bindgen_759b6cec946323f4" ret_char3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_short1@ -} -foreign import ccall safe "hs_bindgen_bf062c8332405f82" ret_short1 :: A -> - IO CShort +ret_short1 = fromBaseForeignType ret_short1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3d9d5e4b8135169a" ret_short2_base :: BaseForeignType (A -> + IO CShort) +{-| __C declaration:__ @ret_short2@ + + __defined at:__ @macros\/reparse.h:54:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_short2@ +-} +ret_short2 :: A -> IO CShort {-| __C declaration:__ @ret_short2@ __defined at:__ @macros\/reparse.h:54:20@ @@ -5555,8 +7229,20 @@ foreign import ccall safe "hs_bindgen_bf062c8332405f82" ret_short1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_short2@ -} -foreign import ccall safe "hs_bindgen_3d9d5e4b8135169a" ret_short2 :: A -> - IO CShort +ret_short2 = fromBaseForeignType ret_short2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_63b44610868e424f" ret_short3_base :: BaseForeignType (A -> + IO CUShort) +{-| __C declaration:__ @ret_short3@ + + __defined at:__ @macros\/reparse.h:55:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_short3@ +-} +ret_short3 :: A -> IO CUShort {-| __C declaration:__ @ret_short3@ __defined at:__ @macros\/reparse.h:55:20@ @@ -5565,8 +7251,20 @@ foreign import ccall safe "hs_bindgen_3d9d5e4b8135169a" ret_short2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_short3@ -} -foreign import ccall safe "hs_bindgen_63b44610868e424f" ret_short3 :: A -> - IO CUShort +ret_short3 = fromBaseForeignType ret_short3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1a8d68c887085fbf" ret_int1_base :: BaseForeignType (A -> + IO CInt) +{-| __C declaration:__ @ret_int1@ + + __defined at:__ @macros\/reparse.h:57:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_int1@ +-} +ret_int1 :: A -> IO CInt {-| __C declaration:__ @ret_int1@ __defined at:__ @macros\/reparse.h:57:20@ @@ -5575,8 +7273,11 @@ foreign import ccall safe "hs_bindgen_63b44610868e424f" ret_short3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_int1@ -} -foreign import ccall safe "hs_bindgen_1a8d68c887085fbf" ret_int1 :: A -> - IO CInt +ret_int1 = fromBaseForeignType ret_int1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f64653c7b4576075" ret_int2_base :: BaseForeignType (A -> + IO CInt) {-| __C declaration:__ @ret_int2@ __defined at:__ @macros\/reparse.h:58:20@ @@ -5585,8 +7286,29 @@ foreign import ccall safe "hs_bindgen_1a8d68c887085fbf" ret_int1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_int2@ -} -foreign import ccall safe "hs_bindgen_f64653c7b4576075" ret_int2 :: A -> - IO CInt +ret_int2 :: A -> IO CInt +{-| __C declaration:__ @ret_int2@ + + __defined at:__ @macros\/reparse.h:58:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_int2@ +-} +ret_int2 = fromBaseForeignType ret_int2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d2030910b711f1d8" ret_int3_base :: BaseForeignType (A -> + IO CUInt) +{-| __C declaration:__ @ret_int3@ + + __defined at:__ @macros\/reparse.h:59:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_int3@ +-} +ret_int3 :: A -> IO CUInt {-| __C declaration:__ @ret_int3@ __defined at:__ @macros\/reparse.h:59:20@ @@ -5595,18 +7317,42 @@ foreign import ccall safe "hs_bindgen_f64653c7b4576075" ret_int2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_int3@ -} -foreign import ccall safe "hs_bindgen_d2030910b711f1d8" ret_int3 :: A -> - IO CUInt +ret_int3 = fromBaseForeignType ret_int3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2d6a30810e6b27e3" ret_long1_base :: BaseForeignType (A -> + IO CLong) {-| __C declaration:__ @ret_long1@ __defined at:__ @macros\/reparse.h:61:20@ __exported by:__ @macros\/reparse.h@ - __unique:__ @test_macrosreparse_Example_Unsafe_ret_long1@ + __unique:__ @test_macrosreparse_Example_Unsafe_ret_long1@ +-} +ret_long1 :: A -> IO CLong +{-| __C declaration:__ @ret_long1@ + + __defined at:__ @macros\/reparse.h:61:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_long1@ +-} +ret_long1 = fromBaseForeignType ret_long1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_02885fe1cf2771da" ret_long2_base :: BaseForeignType (A -> + IO CLong) +{-| __C declaration:__ @ret_long2@ + + __defined at:__ @macros\/reparse.h:62:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_long2@ -} -foreign import ccall safe "hs_bindgen_2d6a30810e6b27e3" ret_long1 :: A -> - IO CLong +ret_long2 :: A -> IO CLong {-| __C declaration:__ @ret_long2@ __defined at:__ @macros\/reparse.h:62:20@ @@ -5615,8 +7361,20 @@ foreign import ccall safe "hs_bindgen_2d6a30810e6b27e3" ret_long1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_long2@ -} -foreign import ccall safe "hs_bindgen_02885fe1cf2771da" ret_long2 :: A -> - IO CLong +ret_long2 = fromBaseForeignType ret_long2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_888c9704132541d5" ret_long3_base :: BaseForeignType (A -> + IO CULong) +{-| __C declaration:__ @ret_long3@ + + __defined at:__ @macros\/reparse.h:63:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_long3@ +-} +ret_long3 :: A -> IO CULong {-| __C declaration:__ @ret_long3@ __defined at:__ @macros\/reparse.h:63:20@ @@ -5625,8 +7383,20 @@ foreign import ccall safe "hs_bindgen_02885fe1cf2771da" ret_long2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_long3@ -} -foreign import ccall safe "hs_bindgen_888c9704132541d5" ret_long3 :: A -> - IO CULong +ret_long3 = fromBaseForeignType ret_long3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2d2ce0d386f26293" ret_float_base :: BaseForeignType (A -> + IO CFloat) +{-| __C declaration:__ @ret_float@ + + __defined at:__ @macros\/reparse.h:65:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_float@ +-} +ret_float :: A -> IO CFloat {-| __C declaration:__ @ret_float@ __defined at:__ @macros\/reparse.h:65:20@ @@ -5635,8 +7405,20 @@ foreign import ccall safe "hs_bindgen_888c9704132541d5" ret_long3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_float@ -} -foreign import ccall safe "hs_bindgen_2d2ce0d386f26293" ret_float :: A -> - IO CFloat +ret_float = fromBaseForeignType ret_float_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_de353a737de53428" ret_double_base :: BaseForeignType (A -> + IO CDouble) +{-| __C declaration:__ @ret_double@ + + __defined at:__ @macros\/reparse.h:66:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_double@ +-} +ret_double :: A -> IO CDouble {-| __C declaration:__ @ret_double@ __defined at:__ @macros\/reparse.h:66:20@ @@ -5645,8 +7427,20 @@ foreign import ccall safe "hs_bindgen_2d2ce0d386f26293" ret_float :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_double@ -} -foreign import ccall safe "hs_bindgen_de353a737de53428" ret_double :: A -> - IO CDouble +ret_double = fromBaseForeignType ret_double_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_91e2ab77e68f0288" ret_bool1_base :: BaseForeignType (A -> + IO CBool) +{-| __C declaration:__ @ret_bool1@ + + __defined at:__ @macros\/reparse.h:67:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_bool1@ +-} +ret_bool1 :: A -> IO CBool {-| __C declaration:__ @ret_bool1@ __defined at:__ @macros\/reparse.h:67:20@ @@ -5655,15 +7449,22 @@ foreign import ccall safe "hs_bindgen_de353a737de53428" ret_double :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_bool1@ -} -foreign import ccall safe "hs_bindgen_91e2ab77e68f0288" ret_bool1 :: A -> - IO CBool +ret_bool1 = fromBaseForeignType ret_bool1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9f29c7eee02f6d53" ret_struct_wrapper_base :: BaseForeignType (A -> + Ptr Some_struct -> + IO Unit) +{-| Pointer-based API for 'ret_struct' + +__unique:__ @test_macrosreparse_Example_Unsafe_ret_struct@ +-} +ret_struct_wrapper :: A -> Ptr Some_struct -> IO Unit {-| Pointer-based API for 'ret_struct' __unique:__ @test_macrosreparse_Example_Unsafe_ret_struct@ -} -foreign import ccall safe "hs_bindgen_9f29c7eee02f6d53" ret_struct_wrapper :: A -> - Ptr Some_struct -> - IO Unit +ret_struct_wrapper = fromBaseForeignType ret_struct_wrapper_base {-| __C declaration:__ @ret_struct@ __defined at:__ @macros\/reparse.h:69:20@ @@ -5678,13 +7479,21 @@ ret_struct :: A -> IO Some_struct __exported by:__ @macros\/reparse.h@ -} ret_struct = \x_0 -> allocaAndPeek (\z_1 -> ret_struct_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6844bf5f5a5f6681" ret_union_wrapper_base :: BaseForeignType (A -> + Ptr Some_union -> + IO Unit) +{-| Pointer-based API for 'ret_union' + +__unique:__ @test_macrosreparse_Example_Unsafe_ret_union@ +-} +ret_union_wrapper :: A -> Ptr Some_union -> IO Unit {-| Pointer-based API for 'ret_union' __unique:__ @test_macrosreparse_Example_Unsafe_ret_union@ -} -foreign import ccall safe "hs_bindgen_6844bf5f5a5f6681" ret_union_wrapper :: A -> - Ptr Some_union -> - IO Unit +ret_union_wrapper = fromBaseForeignType ret_union_wrapper_base {-| __C declaration:__ @ret_union@ __defined at:__ @macros\/reparse.h:70:20@ @@ -5699,6 +7508,19 @@ ret_union :: A -> IO Some_union __exported by:__ @macros\/reparse.h@ -} ret_union = \x_0 -> allocaAndPeek (\z_1 -> ret_union_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f96c4bc30b6b17e8" ret_enum_base :: BaseForeignType (A -> + IO Some_enum) +{-| __C declaration:__ @ret_enum@ + + __defined at:__ @macros\/reparse.h:71:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_enum@ +-} +ret_enum :: A -> IO Some_enum {-| __C declaration:__ @ret_enum@ __defined at:__ @macros\/reparse.h:71:20@ @@ -5707,8 +7529,20 @@ ret_union = \x_0 -> allocaAndPeek (\z_1 -> ret_union_wrapper x_0 z_1) __unique:__ @test_macrosreparse_Example_Unsafe_ret_enum@ -} -foreign import ccall safe "hs_bindgen_f96c4bc30b6b17e8" ret_enum :: A -> - IO Some_enum +ret_enum = fromBaseForeignType ret_enum_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bfb6069e1423e7a5" ret_pointer1_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @ret_pointer1@ + + __defined at:__ @macros\/reparse.h:73:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer1@ +-} +ret_pointer1 :: A -> IO (Ptr CInt) {-| __C declaration:__ @ret_pointer1@ __defined at:__ @macros\/reparse.h:73:20@ @@ -5717,8 +7551,20 @@ foreign import ccall safe "hs_bindgen_f96c4bc30b6b17e8" ret_enum :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer1@ -} -foreign import ccall safe "hs_bindgen_bfb6069e1423e7a5" ret_pointer1 :: A -> - IO (Ptr CInt) +ret_pointer1 = fromBaseForeignType ret_pointer1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ffae633548386d89" ret_pointer2_base :: BaseForeignType (A -> + IO (Ptr (Ptr CInt))) +{-| __C declaration:__ @ret_pointer2@ + + __defined at:__ @macros\/reparse.h:74:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer2@ +-} +ret_pointer2 :: A -> IO (Ptr (Ptr CInt)) {-| __C declaration:__ @ret_pointer2@ __defined at:__ @macros\/reparse.h:74:20@ @@ -5727,8 +7573,20 @@ foreign import ccall safe "hs_bindgen_bfb6069e1423e7a5" ret_pointer1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer2@ -} -foreign import ccall safe "hs_bindgen_ffae633548386d89" ret_pointer2 :: A -> - IO (Ptr (Ptr CInt)) +ret_pointer2 = fromBaseForeignType ret_pointer2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_550cb4a23c6ab2ff" ret_pointer3_base :: BaseForeignType (A -> + IO (Ptr Void)) +{-| __C declaration:__ @ret_pointer3@ + + __defined at:__ @macros\/reparse.h:75:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer3@ +-} +ret_pointer3 :: A -> IO (Ptr Void) {-| __C declaration:__ @ret_pointer3@ __defined at:__ @macros\/reparse.h:75:20@ @@ -5737,8 +7595,20 @@ foreign import ccall safe "hs_bindgen_ffae633548386d89" ret_pointer2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_ret_pointer3@ -} -foreign import ccall safe "hs_bindgen_550cb4a23c6ab2ff" ret_pointer3 :: A -> - IO (Ptr Void) +ret_pointer3 = fromBaseForeignType ret_pointer3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f7a7a45a80ae39f7" body1_base :: BaseForeignType (A -> + IO CInt) +{-| __C declaration:__ @body1@ + + __defined at:__ @macros\/reparse.h:79:5@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_body1@ +-} +body1 :: A -> IO CInt {-| __C declaration:__ @body1@ __defined at:__ @macros\/reparse.h:79:5@ @@ -5747,8 +7617,19 @@ foreign import ccall safe "hs_bindgen_550cb4a23c6ab2ff" ret_pointer3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_body1@ -} -foreign import ccall safe "hs_bindgen_f7a7a45a80ae39f7" body1 :: A -> - IO CInt +body1 = fromBaseForeignType body1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_364e73b014d7d4df" body2_base :: BaseForeignType (IO A) +{-| __C declaration:__ @body2@ + + __defined at:__ @macros\/reparse.h:80:3@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_body2@ +-} +body2 :: IO A {-| __C declaration:__ @body2@ __defined at:__ @macros\/reparse.h:80:3@ @@ -5757,14 +7638,22 @@ foreign import ccall safe "hs_bindgen_f7a7a45a80ae39f7" body1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_body2@ -} -foreign import ccall safe "hs_bindgen_364e73b014d7d4df" body2 :: IO A +body2 = fromBaseForeignType body2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_88b4cd11afc4f6c1" args_complex_float_wrapper_base :: BaseForeignType (A -> + Ptr (Complex CFloat) -> + IO Unit) +{-| Pointer-based API for 'args_complex_float' + +__unique:__ @test_macrosreparse_Example_Unsafe_args_complex_float@ +-} +args_complex_float_wrapper :: A -> Ptr (Complex CFloat) -> IO Unit {-| Pointer-based API for 'args_complex_float' __unique:__ @test_macrosreparse_Example_Unsafe_args_complex_float@ -} -foreign import ccall safe "hs_bindgen_88b4cd11afc4f6c1" args_complex_float_wrapper :: A -> - Ptr (Complex CFloat) -> - IO Unit +args_complex_float_wrapper = fromBaseForeignType args_complex_float_wrapper_base {-| __C declaration:__ @args_complex_float@ __defined at:__ @macros\/reparse.h:84:6@ @@ -5779,13 +7668,22 @@ args_complex_float :: A -> Complex CFloat -> IO Unit __exported by:__ @macros\/reparse.h@ -} args_complex_float = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_complex_float_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0ddc53d8e91cb32a" args_complex_double_wrapper_base :: BaseForeignType (A -> + Ptr (Complex CDouble) -> + IO Unit) +{-| Pointer-based API for 'args_complex_double' + +__unique:__ @test_macrosreparse_Example_Unsafe_args_complex_double@ +-} +args_complex_double_wrapper :: A -> + Ptr (Complex CDouble) -> IO Unit {-| Pointer-based API for 'args_complex_double' __unique:__ @test_macrosreparse_Example_Unsafe_args_complex_double@ -} -foreign import ccall safe "hs_bindgen_0ddc53d8e91cb32a" args_complex_double_wrapper :: A -> - Ptr (Complex CDouble) -> - IO Unit +args_complex_double_wrapper = fromBaseForeignType args_complex_double_wrapper_base {-| __C declaration:__ @args_complex_double@ __defined at:__ @macros\/reparse.h:85:6@ @@ -5800,13 +7698,21 @@ args_complex_double :: A -> Complex CDouble -> IO Unit __exported by:__ @macros\/reparse.h@ -} args_complex_double = \x_0 -> \x_1 -> with x_1 (\y_2 -> args_complex_double_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eb82eb840e288900" ret_complex_float_wrapper_base :: BaseForeignType (A -> + Ptr (Complex CFloat) -> + IO Unit) +{-| Pointer-based API for 'ret_complex_float' + +__unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_float@ +-} +ret_complex_float_wrapper :: A -> Ptr (Complex CFloat) -> IO Unit {-| Pointer-based API for 'ret_complex_float' __unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_float@ -} -foreign import ccall safe "hs_bindgen_eb82eb840e288900" ret_complex_float_wrapper :: A -> - Ptr (Complex CFloat) -> - IO Unit +ret_complex_float_wrapper = fromBaseForeignType ret_complex_float_wrapper_base {-| __C declaration:__ @ret_complex_float@ __defined at:__ @macros\/reparse.h:86:17@ @@ -5821,13 +7727,21 @@ ret_complex_float :: A -> IO (Complex CFloat) __exported by:__ @macros\/reparse.h@ -} ret_complex_float = \x_0 -> allocaAndPeek (\z_1 -> ret_complex_float_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cbc25ea9cbdd2365" ret_complex_double_wrapper_base :: BaseForeignType (A -> + Ptr (Complex CDouble) -> + IO Unit) +{-| Pointer-based API for 'ret_complex_double' + +__unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_double@ +-} +ret_complex_double_wrapper :: A -> Ptr (Complex CDouble) -> IO Unit {-| Pointer-based API for 'ret_complex_double' __unique:__ @test_macrosreparse_Example_Unsafe_ret_complex_double@ -} -foreign import ccall safe "hs_bindgen_cbc25ea9cbdd2365" ret_complex_double_wrapper :: A -> - Ptr (Complex CDouble) -> - IO Unit +ret_complex_double_wrapper = fromBaseForeignType ret_complex_double_wrapper_base {-| __C declaration:__ @ret_complex_double@ __defined at:__ @macros\/reparse.h:87:17@ @@ -5842,6 +7756,20 @@ ret_complex_double :: A -> IO (Complex CDouble) __exported by:__ @macros\/reparse.h@ -} ret_complex_double = \x_0 -> allocaAndPeek (\z_1 -> ret_complex_double_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3258de4ffd2c08af" bespoke_args1_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @bespoke_args1@ + + __defined at:__ @macros\/reparse.h:94:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args1@ +-} +bespoke_args1 :: A -> CBool -> IO Unit {-| __C declaration:__ @bespoke_args1@ __defined at:__ @macros\/reparse.h:94:6@ @@ -5850,8 +7778,21 @@ ret_complex_double = \x_0 -> allocaAndPeek (\z_1 -> ret_complex_double_wrapper x __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args1@ -} -foreign import ccall safe "hs_bindgen_3258de4ffd2c08af" bespoke_args1 :: A -> - CBool -> IO Unit +bespoke_args1 = fromBaseForeignType bespoke_args1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_74b2cd1defdd5609" bespoke_args2_base :: BaseForeignType (A -> + HsBindgen.Runtime.Prelude.CSize -> + IO Unit) +{-| __C declaration:__ @bespoke_args2@ + + __defined at:__ @macros\/reparse.h:95:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args2@ +-} +bespoke_args2 :: A -> HsBindgen.Runtime.Prelude.CSize -> IO Unit {-| __C declaration:__ @bespoke_args2@ __defined at:__ @macros\/reparse.h:95:6@ @@ -5860,9 +7801,20 @@ foreign import ccall safe "hs_bindgen_3258de4ffd2c08af" bespoke_args1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_args2@ -} -foreign import ccall safe "hs_bindgen_74b2cd1defdd5609" bespoke_args2 :: A -> - HsBindgen.Runtime.Prelude.CSize -> - IO Unit +bespoke_args2 = fromBaseForeignType bespoke_args2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5405c1e037d1e115" bespoke_ret1_base :: BaseForeignType (A -> + IO CBool) +{-| __C declaration:__ @bespoke_ret1@ + + __defined at:__ @macros\/reparse.h:97:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret1@ +-} +bespoke_ret1 :: A -> IO CBool {-| __C declaration:__ @bespoke_ret1@ __defined at:__ @macros\/reparse.h:97:8@ @@ -5871,8 +7823,20 @@ foreign import ccall safe "hs_bindgen_74b2cd1defdd5609" bespoke_args2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret1@ -} -foreign import ccall safe "hs_bindgen_5405c1e037d1e115" bespoke_ret1 :: A -> - IO CBool +bespoke_ret1 = fromBaseForeignType bespoke_ret1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a6a3e5a828532360" bespoke_ret2_base :: BaseForeignType (A -> + IO HsBindgen.Runtime.Prelude.CSize) +{-| __C declaration:__ @bespoke_ret2@ + + __defined at:__ @macros\/reparse.h:98:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret2@ +-} +bespoke_ret2 :: A -> IO HsBindgen.Runtime.Prelude.CSize {-| __C declaration:__ @bespoke_ret2@ __defined at:__ @macros\/reparse.h:98:8@ @@ -5881,8 +7845,22 @@ foreign import ccall safe "hs_bindgen_5405c1e037d1e115" bespoke_ret1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_bespoke_ret2@ -} -foreign import ccall safe "hs_bindgen_a6a3e5a828532360" bespoke_ret2 :: A -> - IO HsBindgen.Runtime.Prelude.CSize +bespoke_ret2 = fromBaseForeignType bespoke_ret2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4956a52bf5073b9f" arr_args1_base :: BaseForeignType (Ptr A -> + IO Unit) +{-| Arrays + +__C declaration:__ @arr_args1@ + +__defined at:__ @macros\/reparse.h:104:6@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_arr_args1@ +-} +arr_args1 :: Ptr A -> IO Unit {-| Arrays __C declaration:__ @arr_args1@ @@ -5893,8 +7871,20 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_arr_args1@ -} -foreign import ccall safe "hs_bindgen_4956a52bf5073b9f" arr_args1 :: Ptr A -> - IO Unit +arr_args1 = fromBaseForeignType arr_args1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0fc8b091085a88e9" arr_args2_base :: BaseForeignType (Ptr (Ptr A) -> + IO Unit) +{-| __C declaration:__ @arr_args2@ + + __defined at:__ @macros\/reparse.h:105:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_arr_args2@ +-} +arr_args2 :: Ptr (Ptr A) -> IO Unit {-| __C declaration:__ @arr_args2@ __defined at:__ @macros\/reparse.h:105:6@ @@ -5903,8 +7893,20 @@ foreign import ccall safe "hs_bindgen_4956a52bf5073b9f" arr_args1 :: Ptr A -> __unique:__ @test_macrosreparse_Example_Unsafe_arr_args2@ -} -foreign import ccall safe "hs_bindgen_0fc8b091085a88e9" arr_args2 :: Ptr (Ptr A) -> - IO Unit +arr_args2 = fromBaseForeignType arr_args2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ca6f1bc1a29b85f8" arr_args3_base :: BaseForeignType (Ptr A -> + IO Unit) +{-| __C declaration:__ @arr_args3@ + + __defined at:__ @macros\/reparse.h:106:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_arr_args3@ +-} +arr_args3 :: Ptr A -> IO Unit {-| __C declaration:__ @arr_args3@ __defined at:__ @macros\/reparse.h:106:6@ @@ -5913,8 +7915,20 @@ foreign import ccall safe "hs_bindgen_0fc8b091085a88e9" arr_args2 :: Ptr (Ptr A) __unique:__ @test_macrosreparse_Example_Unsafe_arr_args3@ -} -foreign import ccall safe "hs_bindgen_ca6f1bc1a29b85f8" arr_args3 :: Ptr A -> - IO Unit +arr_args3 = fromBaseForeignType arr_args3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a168ae0de206febe" arr_args4_base :: BaseForeignType (Ptr (Ptr A) -> + IO Unit) +{-| __C declaration:__ @arr_args4@ + + __defined at:__ @macros\/reparse.h:107:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_arr_args4@ +-} +arr_args4 :: Ptr (Ptr A) -> IO Unit {-| __C declaration:__ @arr_args4@ __defined at:__ @macros\/reparse.h:107:6@ @@ -5923,8 +7937,23 @@ foreign import ccall safe "hs_bindgen_ca6f1bc1a29b85f8" arr_args3 :: Ptr A -> __unique:__ @test_macrosreparse_Example_Unsafe_arr_args4@ -} -foreign import ccall safe "hs_bindgen_a168ae0de206febe" arr_args4 :: Ptr (Ptr A) -> - IO Unit +arr_args4 = fromBaseForeignType arr_args4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8e63f57f1f5d662e" funptr_args1_base :: BaseForeignType (A -> + FunPtr (IO Unit) -> + IO Unit) +{-| Function pointers + +__C declaration:__ @funptr_args1@ + +__defined at:__ @macros\/reparse.h:126:6@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_funptr_args1@ +-} +funptr_args1 :: A -> FunPtr (IO Unit) -> IO Unit {-| Function pointers __C declaration:__ @funptr_args1@ @@ -5935,8 +7964,12 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args1@ -} -foreign import ccall safe "hs_bindgen_8e63f57f1f5d662e" funptr_args1 :: A -> - FunPtr (IO Unit) -> IO Unit +funptr_args1 = fromBaseForeignType funptr_args1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_927bd07f48d05d21" funptr_args2_base :: BaseForeignType (A -> + FunPtr (IO CInt) -> + IO Unit) {-| __C declaration:__ @funptr_args2@ __defined at:__ @macros\/reparse.h:127:6@ @@ -5945,8 +7978,31 @@ foreign import ccall safe "hs_bindgen_8e63f57f1f5d662e" funptr_args1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args2@ -} -foreign import ccall safe "hs_bindgen_927bd07f48d05d21" funptr_args2 :: A -> - FunPtr (IO CInt) -> IO Unit +funptr_args2 :: A -> FunPtr (IO CInt) -> IO Unit +{-| __C declaration:__ @funptr_args2@ + + __defined at:__ @macros\/reparse.h:127:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args2@ +-} +funptr_args2 = fromBaseForeignType funptr_args2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c82e078d3c54a6bc" funptr_args3_base :: BaseForeignType (A -> + FunPtr (CInt -> + IO Unit) -> + IO Unit) +{-| __C declaration:__ @funptr_args3@ + + __defined at:__ @macros\/reparse.h:128:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args3@ +-} +funptr_args3 :: A -> FunPtr (CInt -> IO Unit) -> IO Unit {-| __C declaration:__ @funptr_args3@ __defined at:__ @macros\/reparse.h:128:6@ @@ -5955,9 +8011,24 @@ foreign import ccall safe "hs_bindgen_927bd07f48d05d21" funptr_args2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args3@ -} -foreign import ccall safe "hs_bindgen_c82e078d3c54a6bc" funptr_args3 :: A -> - FunPtr (CInt -> IO Unit) -> - IO Unit +funptr_args3 = fromBaseForeignType funptr_args3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_211ad1ac5399caec" funptr_args4_base :: BaseForeignType (A -> + FunPtr (CInt -> + CDouble -> + IO CChar) -> + IO Unit) +{-| __C declaration:__ @funptr_args4@ + + __defined at:__ @macros\/reparse.h:129:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args4@ +-} +funptr_args4 :: A -> + FunPtr (CInt -> CDouble -> IO CChar) -> IO Unit {-| __C declaration:__ @funptr_args4@ __defined at:__ @macros\/reparse.h:129:6@ @@ -5966,24 +8037,50 @@ foreign import ccall safe "hs_bindgen_c82e078d3c54a6bc" funptr_args3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args4@ -} -foreign import ccall safe "hs_bindgen_211ad1ac5399caec" funptr_args4 :: A -> - FunPtr (CInt -> - CDouble -> - IO CChar) -> - IO Unit +funptr_args4 = fromBaseForeignType funptr_args4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9057c59d70e815d7" funptr_args5_base :: BaseForeignType (A -> + FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)) -> + IO Unit) +{-| __C declaration:__ @funptr_args5@ + + __defined at:__ @macros\/reparse.h:130:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args5@ +-} +funptr_args5 :: A -> + FunPtr (CInt -> CDouble -> IO (Ptr CInt)) -> IO Unit {-| __C declaration:__ @funptr_args5@ __defined at:__ @macros\/reparse.h:130:6@ - __exported by:__ @macros\/reparse.h@ + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args5@ +-} +funptr_args5 = fromBaseForeignType funptr_args5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_153515e0ff74574f" comments1_base :: BaseForeignType (A -> + IO Unit) +{-| Comments in awkward places + + (Prior to language-c we failed to parse there.) + +__C declaration:__ @comments1@ + +__defined at:__ @macros\/reparse.h:144:25@ + +__exported by:__ @macros\/reparse.h@ - __unique:__ @test_macrosreparse_Example_Unsafe_funptr_args5@ +__unique:__ @test_macrosreparse_Example_Unsafe_comments1@ -} -foreign import ccall safe "hs_bindgen_9057c59d70e815d7" funptr_args5 :: A -> - FunPtr (CInt -> - CDouble -> - IO (Ptr CInt)) -> - IO Unit +comments1 :: A -> IO Unit {-| Comments in awkward places (Prior to language-c we failed to parse there.) @@ -5996,8 +8093,25 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_comments1@ -} -foreign import ccall safe "hs_bindgen_153515e0ff74574f" comments1 :: A -> - IO Unit +comments1 = fromBaseForeignType comments1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8cc833db463cc95c" const_prim_before1_base :: BaseForeignType (A -> + CChar -> + IO Unit) +{-| `const` qualifier + + NOTE: These were not parsed correctly prior to the switch to language-c. + +__C declaration:__ @const_prim_before1@ + +__defined at:__ @macros\/reparse.h:179:6@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before1@ +-} +const_prim_before1 :: A -> CChar -> IO Unit {-| `const` qualifier NOTE: These were not parsed correctly prior to the switch to language-c. @@ -6010,8 +8124,21 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before1@ -} -foreign import ccall safe "hs_bindgen_8cc833db463cc95c" const_prim_before1 :: A -> - CChar -> IO Unit +const_prim_before1 = fromBaseForeignType const_prim_before1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d767bbef00031d57" const_prim_before2_base :: BaseForeignType (A -> + CSChar -> + IO Unit) +{-| __C declaration:__ @const_prim_before2@ + + __defined at:__ @macros\/reparse.h:180:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before2@ +-} +const_prim_before2 :: A -> CSChar -> IO Unit {-| __C declaration:__ @const_prim_before2@ __defined at:__ @macros\/reparse.h:180:6@ @@ -6020,8 +8147,21 @@ foreign import ccall safe "hs_bindgen_8cc833db463cc95c" const_prim_before1 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before2@ -} -foreign import ccall safe "hs_bindgen_d767bbef00031d57" const_prim_before2 :: A -> - CSChar -> IO Unit +const_prim_before2 = fromBaseForeignType const_prim_before2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a36dfeb811993297" const_prim_before3_base :: BaseForeignType (A -> + CUChar -> + IO Unit) +{-| __C declaration:__ @const_prim_before3@ + + __defined at:__ @macros\/reparse.h:181:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before3@ +-} +const_prim_before3 :: A -> CUChar -> IO Unit {-| __C declaration:__ @const_prim_before3@ __defined at:__ @macros\/reparse.h:181:6@ @@ -6030,8 +8170,21 @@ foreign import ccall safe "hs_bindgen_d767bbef00031d57" const_prim_before2 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_before3@ -} -foreign import ccall safe "hs_bindgen_a36dfeb811993297" const_prim_before3 :: A -> - CUChar -> IO Unit +const_prim_before3 = fromBaseForeignType const_prim_before3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d7fa2440be24e954" const_prim_after1_base :: BaseForeignType (A -> + CChar -> + IO Unit) +{-| __C declaration:__ @const_prim_after1@ + + __defined at:__ @macros\/reparse.h:182:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after1@ +-} +const_prim_after1 :: A -> CChar -> IO Unit {-| __C declaration:__ @const_prim_after1@ __defined at:__ @macros\/reparse.h:182:6@ @@ -6040,8 +8193,21 @@ foreign import ccall safe "hs_bindgen_a36dfeb811993297" const_prim_before3 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after1@ -} -foreign import ccall safe "hs_bindgen_d7fa2440be24e954" const_prim_after1 :: A -> - CChar -> IO Unit +const_prim_after1 = fromBaseForeignType const_prim_after1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c169229f24baf752" const_prim_after2_base :: BaseForeignType (A -> + CSChar -> + IO Unit) +{-| __C declaration:__ @const_prim_after2@ + + __defined at:__ @macros\/reparse.h:183:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after2@ +-} +const_prim_after2 :: A -> CSChar -> IO Unit {-| __C declaration:__ @const_prim_after2@ __defined at:__ @macros\/reparse.h:183:6@ @@ -6050,8 +8216,21 @@ foreign import ccall safe "hs_bindgen_d7fa2440be24e954" const_prim_after1 :: A - __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after2@ -} -foreign import ccall safe "hs_bindgen_c169229f24baf752" const_prim_after2 :: A -> - CSChar -> IO Unit +const_prim_after2 = fromBaseForeignType const_prim_after2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c0780f7624ed1d3e" const_prim_after3_base :: BaseForeignType (A -> + CUChar -> + IO Unit) +{-| __C declaration:__ @const_prim_after3@ + + __defined at:__ @macros\/reparse.h:184:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after3@ +-} +const_prim_after3 :: A -> CUChar -> IO Unit {-| __C declaration:__ @const_prim_after3@ __defined at:__ @macros\/reparse.h:184:6@ @@ -6060,8 +8239,21 @@ foreign import ccall safe "hs_bindgen_c169229f24baf752" const_prim_after2 :: A - __unique:__ @test_macrosreparse_Example_Unsafe_const_prim_after3@ -} -foreign import ccall safe "hs_bindgen_c0780f7624ed1d3e" const_prim_after3 :: A -> - CUChar -> IO Unit +const_prim_after3 = fromBaseForeignType const_prim_after3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fda903bc1139b1d6" const_withoutSign_before1_base :: BaseForeignType (A -> + CFloat -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before1@ + + __defined at:__ @macros\/reparse.h:188:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before1@ +-} +const_withoutSign_before1 :: A -> CFloat -> IO Unit {-| __C declaration:__ @const_withoutSign_before1@ __defined at:__ @macros\/reparse.h:188:6@ @@ -6070,9 +8262,21 @@ foreign import ccall safe "hs_bindgen_c0780f7624ed1d3e" const_prim_after3 :: A - __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before1@ -} -foreign import ccall safe "hs_bindgen_fda903bc1139b1d6" const_withoutSign_before1 :: A -> - CFloat -> - IO Unit +const_withoutSign_before1 = fromBaseForeignType const_withoutSign_before1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a5a70f3be654ea00" const_withoutSign_before2_base :: BaseForeignType (A -> + CDouble -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before2@ + + __defined at:__ @macros\/reparse.h:189:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before2@ +-} +const_withoutSign_before2 :: A -> CDouble -> IO Unit {-| __C declaration:__ @const_withoutSign_before2@ __defined at:__ @macros\/reparse.h:189:6@ @@ -6081,9 +8285,21 @@ foreign import ccall safe "hs_bindgen_fda903bc1139b1d6" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before2@ -} -foreign import ccall safe "hs_bindgen_a5a70f3be654ea00" const_withoutSign_before2 :: A -> - CDouble -> - IO Unit +const_withoutSign_before2 = fromBaseForeignType const_withoutSign_before2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b813910f6a632ce2" const_withoutSign_before3_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before3@ + + __defined at:__ @macros\/reparse.h:190:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before3@ +-} +const_withoutSign_before3 :: A -> CBool -> IO Unit {-| __C declaration:__ @const_withoutSign_before3@ __defined at:__ @macros\/reparse.h:190:6@ @@ -6092,16 +8308,23 @@ foreign import ccall safe "hs_bindgen_a5a70f3be654ea00" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before3@ -} -foreign import ccall safe "hs_bindgen_b813910f6a632ce2" const_withoutSign_before3 :: A -> - CBool -> - IO Unit +const_withoutSign_before3 = fromBaseForeignType const_withoutSign_before3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dc22b02b2f53aa5b" const_withoutSign_before4_wrapper_base :: BaseForeignType (A -> + Ptr Some_struct -> + IO Unit) +{-| Pointer-based API for 'const_withoutSign_before4' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before4@ +-} +const_withoutSign_before4_wrapper :: A -> + Ptr Some_struct -> IO Unit {-| Pointer-based API for 'const_withoutSign_before4' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before4@ -} -foreign import ccall safe "hs_bindgen_dc22b02b2f53aa5b" const_withoutSign_before4_wrapper :: A -> - Ptr Some_struct -> - IO Unit +const_withoutSign_before4_wrapper = fromBaseForeignType const_withoutSign_before4_wrapper_base {-| __C declaration:__ @const_withoutSign_before4@ __defined at:__ @macros\/reparse.h:191:6@ @@ -6116,13 +8339,21 @@ const_withoutSign_before4 :: A -> Some_struct -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before4 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_before4_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_503736261279760d" const_withoutSign_before5_wrapper_base :: BaseForeignType (A -> + Ptr Some_union -> + IO Unit) +{-| Pointer-based API for 'const_withoutSign_before5' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before5@ +-} +const_withoutSign_before5_wrapper :: A -> Ptr Some_union -> IO Unit {-| Pointer-based API for 'const_withoutSign_before5' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before5@ -} -foreign import ccall safe "hs_bindgen_503736261279760d" const_withoutSign_before5_wrapper :: A -> - Ptr Some_union -> - IO Unit +const_withoutSign_before5_wrapper = fromBaseForeignType const_withoutSign_before5_wrapper_base {-| __C declaration:__ @const_withoutSign_before5@ __defined at:__ @macros\/reparse.h:192:6@ @@ -6137,6 +8368,20 @@ const_withoutSign_before5 :: A -> Some_union -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before5 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_before5_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ed0a8c0e15f5d2ce" const_withoutSign_before6_base :: BaseForeignType (A -> + Some_enum -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before6@ + + __defined at:__ @macros\/reparse.h:193:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before6@ +-} +const_withoutSign_before6 :: A -> Some_enum -> IO Unit {-| __C declaration:__ @const_withoutSign_before6@ __defined at:__ @macros\/reparse.h:193:6@ @@ -6145,9 +8390,21 @@ const_withoutSign_before5 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_ __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before6@ -} -foreign import ccall safe "hs_bindgen_ed0a8c0e15f5d2ce" const_withoutSign_before6 :: A -> - Some_enum -> - IO Unit +const_withoutSign_before6 = fromBaseForeignType const_withoutSign_before6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4659c22d39cc1bb3" const_withoutSign_before7_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before7@ + + __defined at:__ @macros\/reparse.h:194:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before7@ +-} +const_withoutSign_before7 :: A -> CBool -> IO Unit {-| __C declaration:__ @const_withoutSign_before7@ __defined at:__ @macros\/reparse.h:194:6@ @@ -6156,9 +8413,22 @@ foreign import ccall safe "hs_bindgen_ed0a8c0e15f5d2ce" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before7@ -} -foreign import ccall safe "hs_bindgen_4659c22d39cc1bb3" const_withoutSign_before7 :: A -> - CBool -> - IO Unit +const_withoutSign_before7 = fromBaseForeignType const_withoutSign_before7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_530245b77093b08c" const_withoutSign_before8_base :: BaseForeignType (A -> + HsBindgen.Runtime.Prelude.CSize -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_before8@ + + __defined at:__ @macros\/reparse.h:195:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before8@ +-} +const_withoutSign_before8 :: A -> + HsBindgen.Runtime.Prelude.CSize -> IO Unit {-| __C declaration:__ @const_withoutSign_before8@ __defined at:__ @macros\/reparse.h:195:6@ @@ -6167,9 +8437,21 @@ foreign import ccall safe "hs_bindgen_4659c22d39cc1bb3" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_before8@ -} -foreign import ccall safe "hs_bindgen_530245b77093b08c" const_withoutSign_before8 :: A -> - HsBindgen.Runtime.Prelude.CSize -> - IO Unit +const_withoutSign_before8 = fromBaseForeignType const_withoutSign_before8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c31a804bd742193e" const_withoutSign_after1_base :: BaseForeignType (A -> + CFloat -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after1@ + + __defined at:__ @macros\/reparse.h:197:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after1@ +-} +const_withoutSign_after1 :: A -> CFloat -> IO Unit {-| __C declaration:__ @const_withoutSign_after1@ __defined at:__ @macros\/reparse.h:197:6@ @@ -6178,9 +8460,21 @@ foreign import ccall safe "hs_bindgen_530245b77093b08c" const_withoutSign_before __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after1@ -} -foreign import ccall safe "hs_bindgen_c31a804bd742193e" const_withoutSign_after1 :: A -> - CFloat -> - IO Unit +const_withoutSign_after1 = fromBaseForeignType const_withoutSign_after1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_53756fa3a68ab067" const_withoutSign_after2_base :: BaseForeignType (A -> + CDouble -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after2@ + + __defined at:__ @macros\/reparse.h:198:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after2@ +-} +const_withoutSign_after2 :: A -> CDouble -> IO Unit {-| __C declaration:__ @const_withoutSign_after2@ __defined at:__ @macros\/reparse.h:198:6@ @@ -6189,9 +8483,21 @@ foreign import ccall safe "hs_bindgen_c31a804bd742193e" const_withoutSign_after1 __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after2@ -} -foreign import ccall safe "hs_bindgen_53756fa3a68ab067" const_withoutSign_after2 :: A -> - CDouble -> - IO Unit +const_withoutSign_after2 = fromBaseForeignType const_withoutSign_after2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4134ad71149d6139" const_withoutSign_after3_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after3@ + + __defined at:__ @macros\/reparse.h:199:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after3@ +-} +const_withoutSign_after3 :: A -> CBool -> IO Unit {-| __C declaration:__ @const_withoutSign_after3@ __defined at:__ @macros\/reparse.h:199:6@ @@ -6200,15 +8506,22 @@ foreign import ccall safe "hs_bindgen_53756fa3a68ab067" const_withoutSign_after2 __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after3@ -} -foreign import ccall safe "hs_bindgen_4134ad71149d6139" const_withoutSign_after3 :: A -> - CBool -> IO Unit +const_withoutSign_after3 = fromBaseForeignType const_withoutSign_after3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3de6157427334101" const_withoutSign_after4_wrapper_base :: BaseForeignType (A -> + Ptr Some_struct -> + IO Unit) +{-| Pointer-based API for 'const_withoutSign_after4' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after4@ +-} +const_withoutSign_after4_wrapper :: A -> Ptr Some_struct -> IO Unit {-| Pointer-based API for 'const_withoutSign_after4' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after4@ -} -foreign import ccall safe "hs_bindgen_3de6157427334101" const_withoutSign_after4_wrapper :: A -> - Ptr Some_struct -> - IO Unit +const_withoutSign_after4_wrapper = fromBaseForeignType const_withoutSign_after4_wrapper_base {-| __C declaration:__ @const_withoutSign_after4@ __defined at:__ @macros\/reparse.h:200:6@ @@ -6223,13 +8536,21 @@ const_withoutSign_after4 :: A -> Some_struct -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after4 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_after4_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fc4ef8c9107c1ae6" const_withoutSign_after5_wrapper_base :: BaseForeignType (A -> + Ptr Some_union -> + IO Unit) +{-| Pointer-based API for 'const_withoutSign_after5' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after5@ +-} +const_withoutSign_after5_wrapper :: A -> Ptr Some_union -> IO Unit {-| Pointer-based API for 'const_withoutSign_after5' __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after5@ -} -foreign import ccall safe "hs_bindgen_fc4ef8c9107c1ae6" const_withoutSign_after5_wrapper :: A -> - Ptr Some_union -> - IO Unit +const_withoutSign_after5_wrapper = fromBaseForeignType const_withoutSign_after5_wrapper_base {-| __C declaration:__ @const_withoutSign_after5@ __defined at:__ @macros\/reparse.h:201:6@ @@ -6244,6 +8565,20 @@ const_withoutSign_after5 :: A -> Some_union -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after5 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_after5_wrapper x_0 y_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5e20c60b725ae606" const_withoutSign_after6_base :: BaseForeignType (A -> + Some_enum -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after6@ + + __defined at:__ @macros\/reparse.h:202:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after6@ +-} +const_withoutSign_after6 :: A -> Some_enum -> IO Unit {-| __C declaration:__ @const_withoutSign_after6@ __defined at:__ @macros\/reparse.h:202:6@ @@ -6252,9 +8587,21 @@ const_withoutSign_after5 = \x_0 -> \x_1 -> with x_1 (\y_2 -> const_withoutSign_a __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after6@ -} -foreign import ccall safe "hs_bindgen_5e20c60b725ae606" const_withoutSign_after6 :: A -> - Some_enum -> - IO Unit +const_withoutSign_after6 = fromBaseForeignType const_withoutSign_after6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a0f20d4b9a07ff5b" const_withoutSign_after7_base :: BaseForeignType (A -> + CBool -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after7@ + + __defined at:__ @macros\/reparse.h:203:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after7@ +-} +const_withoutSign_after7 :: A -> CBool -> IO Unit {-| __C declaration:__ @const_withoutSign_after7@ __defined at:__ @macros\/reparse.h:203:6@ @@ -6263,8 +8610,22 @@ foreign import ccall safe "hs_bindgen_5e20c60b725ae606" const_withoutSign_after6 __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after7@ -} -foreign import ccall safe "hs_bindgen_a0f20d4b9a07ff5b" const_withoutSign_after7 :: A -> - CBool -> IO Unit +const_withoutSign_after7 = fromBaseForeignType const_withoutSign_after7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3a020035eb2fe7f8" const_withoutSign_after8_base :: BaseForeignType (A -> + HsBindgen.Runtime.Prelude.CSize -> + IO Unit) +{-| __C declaration:__ @const_withoutSign_after8@ + + __defined at:__ @macros\/reparse.h:204:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after8@ +-} +const_withoutSign_after8 :: A -> + HsBindgen.Runtime.Prelude.CSize -> IO Unit {-| __C declaration:__ @const_withoutSign_after8@ __defined at:__ @macros\/reparse.h:204:6@ @@ -6273,9 +8634,21 @@ foreign import ccall safe "hs_bindgen_a0f20d4b9a07ff5b" const_withoutSign_after7 __unique:__ @test_macrosreparse_Example_Unsafe_const_withoutSign_after8@ -} -foreign import ccall safe "hs_bindgen_3a020035eb2fe7f8" const_withoutSign_after8 :: A -> - HsBindgen.Runtime.Prelude.CSize -> - IO Unit +const_withoutSign_after8 = fromBaseForeignType const_withoutSign_after8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_17623ba5065bf95d" const_pointers_args1_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @const_pointers_args1@ + + __defined at:__ @macros\/reparse.h:208:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args1@ +-} +const_pointers_args1 :: A -> Ptr CInt -> IO Unit {-| __C declaration:__ @const_pointers_args1@ __defined at:__ @macros\/reparse.h:208:6@ @@ -6284,8 +8657,21 @@ foreign import ccall safe "hs_bindgen_3a020035eb2fe7f8" const_withoutSign_after8 __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args1@ -} -foreign import ccall safe "hs_bindgen_17623ba5065bf95d" const_pointers_args1 :: A -> - Ptr CInt -> IO Unit +const_pointers_args1 = fromBaseForeignType const_pointers_args1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_02d08ccd5df88a98" const_pointers_args2_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @const_pointers_args2@ + + __defined at:__ @macros\/reparse.h:209:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args2@ +-} +const_pointers_args2 :: A -> Ptr CInt -> IO Unit {-| __C declaration:__ @const_pointers_args2@ __defined at:__ @macros\/reparse.h:209:6@ @@ -6294,8 +8680,21 @@ foreign import ccall safe "hs_bindgen_17623ba5065bf95d" const_pointers_args1 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args2@ -} -foreign import ccall safe "hs_bindgen_02d08ccd5df88a98" const_pointers_args2 :: A -> - Ptr CInt -> IO Unit +const_pointers_args2 = fromBaseForeignType const_pointers_args2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_50c423f2237cb6b5" const_pointers_args3_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @const_pointers_args3@ + + __defined at:__ @macros\/reparse.h:210:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args3@ +-} +const_pointers_args3 :: A -> Ptr CInt -> IO Unit {-| __C declaration:__ @const_pointers_args3@ __defined at:__ @macros\/reparse.h:210:6@ @@ -6304,8 +8703,21 @@ foreign import ccall safe "hs_bindgen_02d08ccd5df88a98" const_pointers_args2 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args3@ -} -foreign import ccall safe "hs_bindgen_50c423f2237cb6b5" const_pointers_args3 :: A -> - Ptr CInt -> IO Unit +const_pointers_args3 = fromBaseForeignType const_pointers_args3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_99c29c45d78348e9" const_pointers_args4_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @const_pointers_args4@ + + __defined at:__ @macros\/reparse.h:211:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args4@ +-} +const_pointers_args4 :: A -> Ptr CInt -> IO Unit {-| __C declaration:__ @const_pointers_args4@ __defined at:__ @macros\/reparse.h:211:6@ @@ -6314,8 +8726,21 @@ foreign import ccall safe "hs_bindgen_50c423f2237cb6b5" const_pointers_args3 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args4@ -} -foreign import ccall safe "hs_bindgen_99c29c45d78348e9" const_pointers_args4 :: A -> - Ptr CInt -> IO Unit +const_pointers_args4 = fromBaseForeignType const_pointers_args4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6a92dbfae24b1bcd" const_pointers_args5_base :: BaseForeignType (A -> + Ptr CInt -> + IO Unit) +{-| __C declaration:__ @const_pointers_args5@ + + __defined at:__ @macros\/reparse.h:212:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args5@ +-} +const_pointers_args5 :: A -> Ptr CInt -> IO Unit {-| __C declaration:__ @const_pointers_args5@ __defined at:__ @macros\/reparse.h:212:6@ @@ -6324,8 +8749,11 @@ foreign import ccall safe "hs_bindgen_99c29c45d78348e9" const_pointers_args4 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_args5@ -} -foreign import ccall safe "hs_bindgen_6a92dbfae24b1bcd" const_pointers_args5 :: A -> - Ptr CInt -> IO Unit +const_pointers_args5 = fromBaseForeignType const_pointers_args5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0c07f1e0256fd705" const_pointers_ret1_base :: BaseForeignType (A -> + IO (Ptr CInt)) {-| __C declaration:__ @const_pointers_ret1@ __defined at:__ @macros\/reparse.h:214:19@ @@ -6334,8 +8762,29 @@ foreign import ccall safe "hs_bindgen_6a92dbfae24b1bcd" const_pointers_args5 :: __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret1@ -} -foreign import ccall safe "hs_bindgen_0c07f1e0256fd705" const_pointers_ret1 :: A -> - IO (Ptr CInt) +const_pointers_ret1 :: A -> IO (Ptr CInt) +{-| __C declaration:__ @const_pointers_ret1@ + + __defined at:__ @macros\/reparse.h:214:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret1@ +-} +const_pointers_ret1 = fromBaseForeignType const_pointers_ret1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d12c8210ff3c3711" const_pointers_ret2_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @const_pointers_ret2@ + + __defined at:__ @macros\/reparse.h:215:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret2@ +-} +const_pointers_ret2 :: A -> IO (Ptr CInt) {-| __C declaration:__ @const_pointers_ret2@ __defined at:__ @macros\/reparse.h:215:19@ @@ -6344,8 +8793,20 @@ foreign import ccall safe "hs_bindgen_0c07f1e0256fd705" const_pointers_ret1 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret2@ -} -foreign import ccall safe "hs_bindgen_d12c8210ff3c3711" const_pointers_ret2 :: A -> - IO (Ptr CInt) +const_pointers_ret2 = fromBaseForeignType const_pointers_ret2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a58bc0be6f564801" const_pointers_ret3_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @const_pointers_ret3@ + + __defined at:__ @macros\/reparse.h:216:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret3@ +-} +const_pointers_ret3 :: A -> IO (Ptr CInt) {-| __C declaration:__ @const_pointers_ret3@ __defined at:__ @macros\/reparse.h:216:19@ @@ -6354,8 +8815,20 @@ foreign import ccall safe "hs_bindgen_d12c8210ff3c3711" const_pointers_ret2 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret3@ -} -foreign import ccall safe "hs_bindgen_a58bc0be6f564801" const_pointers_ret3 :: A -> - IO (Ptr CInt) +const_pointers_ret3 = fromBaseForeignType const_pointers_ret3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_622bb8150470138b" const_pointers_ret4_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @const_pointers_ret4@ + + __defined at:__ @macros\/reparse.h:217:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret4@ +-} +const_pointers_ret4 :: A -> IO (Ptr CInt) {-| __C declaration:__ @const_pointers_ret4@ __defined at:__ @macros\/reparse.h:217:19@ @@ -6364,8 +8837,20 @@ foreign import ccall safe "hs_bindgen_a58bc0be6f564801" const_pointers_ret3 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret4@ -} -foreign import ccall safe "hs_bindgen_622bb8150470138b" const_pointers_ret4 :: A -> - IO (Ptr CInt) +const_pointers_ret4 = fromBaseForeignType const_pointers_ret4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d49bd331ad2077e5" const_pointers_ret5_base :: BaseForeignType (A -> + IO (Ptr CInt)) +{-| __C declaration:__ @const_pointers_ret5@ + + __defined at:__ @macros\/reparse.h:218:19@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret5@ +-} +const_pointers_ret5 :: A -> IO (Ptr CInt) {-| __C declaration:__ @const_pointers_ret5@ __defined at:__ @macros\/reparse.h:218:19@ @@ -6374,14 +8859,21 @@ foreign import ccall safe "hs_bindgen_622bb8150470138b" const_pointers_ret4 :: A __unique:__ @test_macrosreparse_Example_Unsafe_const_pointers_ret5@ -} -foreign import ccall safe "hs_bindgen_d49bd331ad2077e5" const_pointers_ret5 :: A -> - IO (Ptr CInt) +const_pointers_ret5 = fromBaseForeignType const_pointers_ret5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_224608f780bff5bd" const_array_elem1_wrapper_base :: BaseForeignType (Ptr A -> + IO Unit) +{-| Pointer-based API for 'const_array_elem1' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem1@ +-} +const_array_elem1_wrapper :: Ptr A -> IO Unit {-| Pointer-based API for 'const_array_elem1' __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem1@ -} -foreign import ccall safe "hs_bindgen_224608f780bff5bd" const_array_elem1_wrapper :: Ptr A -> - IO Unit +const_array_elem1_wrapper = fromBaseForeignType const_array_elem1_wrapper_base {-| __C declaration:__ @const_array_elem1@ __defined at:__ @macros\/reparse.h:246:6@ @@ -6396,6 +8888,19 @@ const_array_elem1 :: IncompleteArray A -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_array_elem1 = \x_0 -> withPtr x_0 (\ptr_1 -> const_array_elem1_wrapper ptr_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9aa74ad89f2c1fba" const_array_elem2_base :: BaseForeignType (Ptr (Ptr A) -> + IO Unit) +{-| __C declaration:__ @const_array_elem2@ + + __defined at:__ @macros\/reparse.h:247:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem2@ +-} +const_array_elem2 :: Ptr (Ptr A) -> IO Unit {-| __C declaration:__ @const_array_elem2@ __defined at:__ @macros\/reparse.h:247:6@ @@ -6404,14 +8909,21 @@ const_array_elem1 = \x_0 -> withPtr x_0 (\ptr_1 -> const_array_elem1_wrapper ptr __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem2@ -} -foreign import ccall safe "hs_bindgen_9aa74ad89f2c1fba" const_array_elem2 :: Ptr (Ptr A) -> - IO Unit +const_array_elem2 = fromBaseForeignType const_array_elem2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6a328300c5ef0c9e" const_array_elem3_wrapper_base :: BaseForeignType (Ptr (Ptr A) -> + IO Unit) +{-| Pointer-based API for 'const_array_elem3' + +__unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem3@ +-} +const_array_elem3_wrapper :: Ptr (Ptr A) -> IO Unit {-| Pointer-based API for 'const_array_elem3' __unique:__ @test_macrosreparse_Example_Unsafe_const_array_elem3@ -} -foreign import ccall safe "hs_bindgen_6a328300c5ef0c9e" const_array_elem3_wrapper :: Ptr (Ptr A) -> - IO Unit +const_array_elem3_wrapper = fromBaseForeignType const_array_elem3_wrapper_base {-| __C declaration:__ @const_array_elem3@ __defined at:__ @macros\/reparse.h:248:6@ @@ -6426,6 +8938,9 @@ const_array_elem3 :: IncompleteArray (Ptr A) -> IO Unit __exported by:__ @macros\/reparse.h@ -} const_array_elem3 = \x_0 -> withPtr x_0 (\ptr_1 -> const_array_elem3_wrapper ptr_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_13a7d78e11555d58" noParams1_base :: BaseForeignType (IO A) {-| Other examples we reparsed /incorrectly/ before language-c __C declaration:__ @noParams1@ @@ -6436,7 +8951,30 @@ __exported by:__ @macros\/reparse.h@ __unique:__ @test_macrosreparse_Example_Unsafe_noParams1@ -} -foreign import ccall safe "hs_bindgen_13a7d78e11555d58" noParams1 :: IO A +noParams1 :: IO A +{-| Other examples we reparsed /incorrectly/ before language-c + +__C declaration:__ @noParams1@ + +__defined at:__ @macros\/reparse.h:256:3@ + +__exported by:__ @macros\/reparse.h@ + +__unique:__ @test_macrosreparse_Example_Unsafe_noParams1@ +-} +noParams1 = fromBaseForeignType noParams1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_672f4691ee7a367c" noParams2_base :: BaseForeignType (IO A) +{-| __C declaration:__ @noParams2@ + + __defined at:__ @macros\/reparse.h:257:3@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_noParams2@ +-} +noParams2 :: IO A {-| __C declaration:__ @noParams2@ __defined at:__ @macros\/reparse.h:257:3@ @@ -6445,7 +8983,21 @@ foreign import ccall safe "hs_bindgen_13a7d78e11555d58" noParams1 :: IO A __unique:__ @test_macrosreparse_Example_Unsafe_noParams2@ -} -foreign import ccall safe "hs_bindgen_672f4691ee7a367c" noParams2 :: IO A +noParams2 = fromBaseForeignType noParams2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_591f84e2163a5d18" noParams3_base :: BaseForeignType (A -> + FunPtr (IO CInt) -> + IO Unit) +{-| __C declaration:__ @noParams3@ + + __defined at:__ @macros\/reparse.h:258:6@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_noParams3@ +-} +noParams3 :: A -> FunPtr (IO CInt) -> IO Unit {-| __C declaration:__ @noParams3@ __defined at:__ @macros\/reparse.h:258:6@ @@ -6454,8 +9006,20 @@ foreign import ccall safe "hs_bindgen_672f4691ee7a367c" noParams2 :: IO A __unique:__ @test_macrosreparse_Example_Unsafe_noParams3@ -} -foreign import ccall safe "hs_bindgen_591f84e2163a5d18" noParams3 :: A -> - FunPtr (IO CInt) -> IO Unit +noParams3 = fromBaseForeignType noParams3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8cdf7774adb0f0b4" funptr_ret1_base :: BaseForeignType (A -> + IO (FunPtr (IO Unit))) +{-| __C declaration:__ @funptr_ret1@ + + __defined at:__ @macros\/reparse.h:262:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret1@ +-} +funptr_ret1 :: A -> IO (FunPtr (IO Unit)) {-| __C declaration:__ @funptr_ret1@ __defined at:__ @macros\/reparse.h:262:8@ @@ -6464,8 +9028,20 @@ foreign import ccall safe "hs_bindgen_591f84e2163a5d18" noParams3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret1@ -} -foreign import ccall safe "hs_bindgen_8cdf7774adb0f0b4" funptr_ret1 :: A -> - IO (FunPtr (IO Unit)) +funptr_ret1 = fromBaseForeignType funptr_ret1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a4e08267a9070ede" funptr_ret2_base :: BaseForeignType (A -> + IO (FunPtr (IO CInt))) +{-| __C declaration:__ @funptr_ret2@ + + __defined at:__ @macros\/reparse.h:263:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret2@ +-} +funptr_ret2 :: A -> IO (FunPtr (IO CInt)) {-| __C declaration:__ @funptr_ret2@ __defined at:__ @macros\/reparse.h:263:8@ @@ -6474,8 +9050,21 @@ foreign import ccall safe "hs_bindgen_8cdf7774adb0f0b4" funptr_ret1 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret2@ -} -foreign import ccall safe "hs_bindgen_a4e08267a9070ede" funptr_ret2 :: A -> - IO (FunPtr (IO CInt)) +funptr_ret2 = fromBaseForeignType funptr_ret2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_65fa30510d244cbf" funptr_ret3_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + IO Unit))) +{-| __C declaration:__ @funptr_ret3@ + + __defined at:__ @macros\/reparse.h:264:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret3@ +-} +funptr_ret3 :: A -> IO (FunPtr (CInt -> IO Unit)) {-| __C declaration:__ @funptr_ret3@ __defined at:__ @macros\/reparse.h:264:8@ @@ -6484,8 +9073,22 @@ foreign import ccall safe "hs_bindgen_a4e08267a9070ede" funptr_ret2 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret3@ -} -foreign import ccall safe "hs_bindgen_65fa30510d244cbf" funptr_ret3 :: A -> - IO (FunPtr (CInt -> IO Unit)) +funptr_ret3 = fromBaseForeignType funptr_ret3_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_da12eaec295883aa" funptr_ret4_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO CChar))) +{-| __C declaration:__ @funptr_ret4@ + + __defined at:__ @macros\/reparse.h:265:8@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret4@ +-} +funptr_ret4 :: A -> IO (FunPtr (CInt -> CDouble -> IO CChar)) {-| __C declaration:__ @funptr_ret4@ __defined at:__ @macros\/reparse.h:265:8@ @@ -6494,10 +9097,22 @@ foreign import ccall safe "hs_bindgen_65fa30510d244cbf" funptr_ret3 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret4@ -} -foreign import ccall safe "hs_bindgen_da12eaec295883aa" funptr_ret4 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO CChar)) +funptr_ret4 = fromBaseForeignType funptr_ret4_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_281c53214b1cdcb4" funptr_ret5_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret5@ + + __defined at:__ @macros\/reparse.h:269:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret5@ +-} +funptr_ret5 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret5@ __defined at:__ @macros\/reparse.h:269:20@ @@ -6506,10 +9121,22 @@ foreign import ccall safe "hs_bindgen_da12eaec295883aa" funptr_ret4 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret5@ -} -foreign import ccall safe "hs_bindgen_281c53214b1cdcb4" funptr_ret5 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret5 = fromBaseForeignType funptr_ret5_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_16628c257aa64a76" funptr_ret6_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret6@ + + __defined at:__ @macros\/reparse.h:270:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret6@ +-} +funptr_ret6 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret6@ __defined at:__ @macros\/reparse.h:270:20@ @@ -6518,10 +9145,22 @@ foreign import ccall safe "hs_bindgen_281c53214b1cdcb4" funptr_ret5 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret6@ -} -foreign import ccall safe "hs_bindgen_16628c257aa64a76" funptr_ret6 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret6 = fromBaseForeignType funptr_ret6_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_79fb0c30f546a547" funptr_ret7_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret7@ + + __defined at:__ @macros\/reparse.h:271:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret7@ +-} +funptr_ret7 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret7@ __defined at:__ @macros\/reparse.h:271:20@ @@ -6530,10 +9169,22 @@ foreign import ccall safe "hs_bindgen_16628c257aa64a76" funptr_ret6 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret7@ -} -foreign import ccall safe "hs_bindgen_79fb0c30f546a547" funptr_ret7 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret7 = fromBaseForeignType funptr_ret7_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4668d2ff9d5bfc40" funptr_ret8_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret8@ + + __defined at:__ @macros\/reparse.h:272:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret8@ +-} +funptr_ret8 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret8@ __defined at:__ @macros\/reparse.h:272:20@ @@ -6542,10 +9193,22 @@ foreign import ccall safe "hs_bindgen_79fb0c30f546a547" funptr_ret7 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret8@ -} -foreign import ccall safe "hs_bindgen_4668d2ff9d5bfc40" funptr_ret8 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret8 = fromBaseForeignType funptr_ret8_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c044d7074789febc" funptr_ret9_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret9@ + + __defined at:__ @macros\/reparse.h:273:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret9@ +-} +funptr_ret9 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret9@ __defined at:__ @macros\/reparse.h:273:20@ @@ -6554,10 +9217,22 @@ foreign import ccall safe "hs_bindgen_4668d2ff9d5bfc40" funptr_ret8 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret9@ -} -foreign import ccall safe "hs_bindgen_c044d7074789febc" funptr_ret9 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret9 = fromBaseForeignType funptr_ret9_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_628ced6eccc7783a" funptr_ret10_base :: BaseForeignType (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))) +{-| __C declaration:__ @funptr_ret10@ + + __defined at:__ @macros\/reparse.h:274:20@ + + __exported by:__ @macros\/reparse.h@ + + __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret10@ +-} +funptr_ret10 :: A -> IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))) {-| __C declaration:__ @funptr_ret10@ __defined at:__ @macros\/reparse.h:274:20@ @@ -6566,15 +9241,18 @@ foreign import ccall safe "hs_bindgen_c044d7074789febc" funptr_ret9 :: A -> __unique:__ @test_macrosreparse_Example_Unsafe_funptr_ret10@ -} -foreign import ccall safe "hs_bindgen_628ced6eccc7783a" funptr_ret10 :: A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))) +funptr_ret10 = fromBaseForeignType funptr_ret10_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_83aaba90c800683a" hs_bindgen_83aaba90c800683a_base :: BaseForeignType (IO (FunPtr (A -> + CChar -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_args_char1_ptr@ -} -foreign import ccall safe "hs_bindgen_83aaba90c800683a" hs_bindgen_83aaba90c800683a :: IO (FunPtr (A -> - CChar -> - IO Unit)) +hs_bindgen_83aaba90c800683a :: IO (FunPtr (A -> CChar -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_args_char1_ptr@ +-} +hs_bindgen_83aaba90c800683a = fromBaseForeignType hs_bindgen_83aaba90c800683a_base {-# NOINLINE args_char1_ptr #-} {-| Function declarations @@ -6594,11 +9272,17 @@ __defined at:__ @macros\/reparse.h:17:6@ __exported by:__ @macros\/reparse.h@ -} args_char1_ptr = unsafePerformIO hs_bindgen_83aaba90c800683a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e7c58099a677e598" hs_bindgen_e7c58099a677e598_base :: BaseForeignType (IO (FunPtr (A -> + CSChar -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_args_char2_ptr@ -} -foreign import ccall safe "hs_bindgen_e7c58099a677e598" hs_bindgen_e7c58099a677e598 :: IO (FunPtr (A -> - CSChar -> - IO Unit)) +hs_bindgen_e7c58099a677e598 :: IO (FunPtr (A -> CSChar -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_args_char2_ptr@ +-} +hs_bindgen_e7c58099a677e598 = fromBaseForeignType hs_bindgen_e7c58099a677e598_base {-# NOINLINE args_char2_ptr #-} {-| __C declaration:__ @args_char2@ @@ -6614,11 +9298,17 @@ args_char2_ptr :: FunPtr (A -> CSChar -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_char2_ptr = unsafePerformIO hs_bindgen_e7c58099a677e598 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cc33f1bf42bb14f7" hs_bindgen_cc33f1bf42bb14f7_base :: BaseForeignType (IO (FunPtr (A -> + CUChar -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_args_char3_ptr@ -} -foreign import ccall safe "hs_bindgen_cc33f1bf42bb14f7" hs_bindgen_cc33f1bf42bb14f7 :: IO (FunPtr (A -> - CUChar -> - IO Unit)) +hs_bindgen_cc33f1bf42bb14f7 :: IO (FunPtr (A -> CUChar -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_args_char3_ptr@ +-} +hs_bindgen_cc33f1bf42bb14f7 = fromBaseForeignType hs_bindgen_cc33f1bf42bb14f7_base {-# NOINLINE args_char3_ptr #-} {-| __C declaration:__ @args_char3@ @@ -6634,11 +9324,17 @@ args_char3_ptr :: FunPtr (A -> CUChar -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_char3_ptr = unsafePerformIO hs_bindgen_cc33f1bf42bb14f7 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_daf63941377bc30d" hs_bindgen_daf63941377bc30d_base :: BaseForeignType (IO (FunPtr (A -> + CShort -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_short1_ptr@ +-} +hs_bindgen_daf63941377bc30d :: IO (FunPtr (A -> CShort -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_short1_ptr@ -} -foreign import ccall safe "hs_bindgen_daf63941377bc30d" hs_bindgen_daf63941377bc30d :: IO (FunPtr (A -> - CShort -> - IO Unit)) +hs_bindgen_daf63941377bc30d = fromBaseForeignType hs_bindgen_daf63941377bc30d_base {-# NOINLINE args_short1_ptr #-} {-| __C declaration:__ @args_short1@ @@ -6654,11 +9350,17 @@ args_short1_ptr :: FunPtr (A -> CShort -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_short1_ptr = unsafePerformIO hs_bindgen_daf63941377bc30d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f832e83c66e73e1b" hs_bindgen_f832e83c66e73e1b_base :: BaseForeignType (IO (FunPtr (A -> + CShort -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_short2_ptr@ +-} +hs_bindgen_f832e83c66e73e1b :: IO (FunPtr (A -> CShort -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_short2_ptr@ -} -foreign import ccall safe "hs_bindgen_f832e83c66e73e1b" hs_bindgen_f832e83c66e73e1b :: IO (FunPtr (A -> - CShort -> - IO Unit)) +hs_bindgen_f832e83c66e73e1b = fromBaseForeignType hs_bindgen_f832e83c66e73e1b_base {-# NOINLINE args_short2_ptr #-} {-| __C declaration:__ @args_short2@ @@ -6674,11 +9376,18 @@ args_short2_ptr :: FunPtr (A -> CShort -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_short2_ptr = unsafePerformIO hs_bindgen_f832e83c66e73e1b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fddcd4eb9a3ac90f" hs_bindgen_fddcd4eb9a3ac90f_base :: BaseForeignType (IO (FunPtr (A -> + CUShort -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_short3_ptr@ +-} +hs_bindgen_fddcd4eb9a3ac90f :: IO (FunPtr (A -> + CUShort -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_short3_ptr@ -} -foreign import ccall safe "hs_bindgen_fddcd4eb9a3ac90f" hs_bindgen_fddcd4eb9a3ac90f :: IO (FunPtr (A -> - CUShort -> - IO Unit)) +hs_bindgen_fddcd4eb9a3ac90f = fromBaseForeignType hs_bindgen_fddcd4eb9a3ac90f_base {-# NOINLINE args_short3_ptr #-} {-| __C declaration:__ @args_short3@ @@ -6694,11 +9403,17 @@ args_short3_ptr :: FunPtr (A -> CUShort -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_short3_ptr = unsafePerformIO hs_bindgen_fddcd4eb9a3ac90f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8f495550fa03ecd7" hs_bindgen_8f495550fa03ecd7_base :: BaseForeignType (IO (FunPtr (A -> + CInt -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_args_int1_ptr@ -} -foreign import ccall safe "hs_bindgen_8f495550fa03ecd7" hs_bindgen_8f495550fa03ecd7 :: IO (FunPtr (A -> - CInt -> - IO Unit)) +hs_bindgen_8f495550fa03ecd7 :: IO (FunPtr (A -> CInt -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_args_int1_ptr@ +-} +hs_bindgen_8f495550fa03ecd7 = fromBaseForeignType hs_bindgen_8f495550fa03ecd7_base {-# NOINLINE args_int1_ptr #-} {-| __C declaration:__ @args_int1@ @@ -6714,11 +9429,17 @@ args_int1_ptr :: FunPtr (A -> CInt -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_int1_ptr = unsafePerformIO hs_bindgen_8f495550fa03ecd7 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_488a7dcf2bd33678" hs_bindgen_488a7dcf2bd33678_base :: BaseForeignType (IO (FunPtr (A -> + CInt -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_int2_ptr@ +-} +hs_bindgen_488a7dcf2bd33678 :: IO (FunPtr (A -> CInt -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_int2_ptr@ -} -foreign import ccall safe "hs_bindgen_488a7dcf2bd33678" hs_bindgen_488a7dcf2bd33678 :: IO (FunPtr (A -> - CInt -> - IO Unit)) +hs_bindgen_488a7dcf2bd33678 = fromBaseForeignType hs_bindgen_488a7dcf2bd33678_base {-# NOINLINE args_int2_ptr #-} {-| __C declaration:__ @args_int2@ @@ -6734,11 +9455,17 @@ args_int2_ptr :: FunPtr (A -> CInt -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_int2_ptr = unsafePerformIO hs_bindgen_488a7dcf2bd33678 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5c6e85e96378ce0f" hs_bindgen_5c6e85e96378ce0f_base :: BaseForeignType (IO (FunPtr (A -> + CUInt -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_int3_ptr@ +-} +hs_bindgen_5c6e85e96378ce0f :: IO (FunPtr (A -> CUInt -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_int3_ptr@ -} -foreign import ccall safe "hs_bindgen_5c6e85e96378ce0f" hs_bindgen_5c6e85e96378ce0f :: IO (FunPtr (A -> - CUInt -> - IO Unit)) +hs_bindgen_5c6e85e96378ce0f = fromBaseForeignType hs_bindgen_5c6e85e96378ce0f_base {-# NOINLINE args_int3_ptr #-} {-| __C declaration:__ @args_int3@ @@ -6754,11 +9481,17 @@ args_int3_ptr :: FunPtr (A -> CUInt -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_int3_ptr = unsafePerformIO hs_bindgen_5c6e85e96378ce0f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_afcad03e61d3f83b" hs_bindgen_afcad03e61d3f83b_base :: BaseForeignType (IO (FunPtr (A -> + CLong -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_long1_ptr@ +-} +hs_bindgen_afcad03e61d3f83b :: IO (FunPtr (A -> CLong -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_long1_ptr@ -} -foreign import ccall safe "hs_bindgen_afcad03e61d3f83b" hs_bindgen_afcad03e61d3f83b :: IO (FunPtr (A -> - CLong -> - IO Unit)) +hs_bindgen_afcad03e61d3f83b = fromBaseForeignType hs_bindgen_afcad03e61d3f83b_base {-# NOINLINE args_long1_ptr #-} {-| __C declaration:__ @args_long1@ @@ -6774,11 +9507,17 @@ args_long1_ptr :: FunPtr (A -> CLong -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_long1_ptr = unsafePerformIO hs_bindgen_afcad03e61d3f83b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2d32bae595df94c2" hs_bindgen_2d32bae595df94c2_base :: BaseForeignType (IO (FunPtr (A -> + CLong -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_args_long2_ptr@ -} -foreign import ccall safe "hs_bindgen_2d32bae595df94c2" hs_bindgen_2d32bae595df94c2 :: IO (FunPtr (A -> - CLong -> - IO Unit)) +hs_bindgen_2d32bae595df94c2 :: IO (FunPtr (A -> CLong -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_args_long2_ptr@ +-} +hs_bindgen_2d32bae595df94c2 = fromBaseForeignType hs_bindgen_2d32bae595df94c2_base {-# NOINLINE args_long2_ptr #-} {-| __C declaration:__ @args_long2@ @@ -6794,11 +9533,17 @@ args_long2_ptr :: FunPtr (A -> CLong -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_long2_ptr = unsafePerformIO hs_bindgen_2d32bae595df94c2 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0f7d316338eac027" hs_bindgen_0f7d316338eac027_base :: BaseForeignType (IO (FunPtr (A -> + CULong -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_long3_ptr@ +-} +hs_bindgen_0f7d316338eac027 :: IO (FunPtr (A -> CULong -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_long3_ptr@ -} -foreign import ccall safe "hs_bindgen_0f7d316338eac027" hs_bindgen_0f7d316338eac027 :: IO (FunPtr (A -> - CULong -> - IO Unit)) +hs_bindgen_0f7d316338eac027 = fromBaseForeignType hs_bindgen_0f7d316338eac027_base {-# NOINLINE args_long3_ptr #-} {-| __C declaration:__ @args_long3@ @@ -6814,11 +9559,17 @@ args_long3_ptr :: FunPtr (A -> CULong -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_long3_ptr = unsafePerformIO hs_bindgen_0f7d316338eac027 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9ed3dd630c6a5c91" hs_bindgen_9ed3dd630c6a5c91_base :: BaseForeignType (IO (FunPtr (A -> + CFloat -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_float_ptr@ +-} +hs_bindgen_9ed3dd630c6a5c91 :: IO (FunPtr (A -> CFloat -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_float_ptr@ -} -foreign import ccall safe "hs_bindgen_9ed3dd630c6a5c91" hs_bindgen_9ed3dd630c6a5c91 :: IO (FunPtr (A -> - CFloat -> - IO Unit)) +hs_bindgen_9ed3dd630c6a5c91 = fromBaseForeignType hs_bindgen_9ed3dd630c6a5c91_base {-# NOINLINE args_float_ptr #-} {-| __C declaration:__ @args_float@ @@ -6834,11 +9585,18 @@ args_float_ptr :: FunPtr (A -> CFloat -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_float_ptr = unsafePerformIO hs_bindgen_9ed3dd630c6a5c91 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c1afad204f639896" hs_bindgen_c1afad204f639896_base :: BaseForeignType (IO (FunPtr (A -> + CDouble -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_double_ptr@ +-} +hs_bindgen_c1afad204f639896 :: IO (FunPtr (A -> + CDouble -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_double_ptr@ -} -foreign import ccall safe "hs_bindgen_c1afad204f639896" hs_bindgen_c1afad204f639896 :: IO (FunPtr (A -> - CDouble -> - IO Unit)) +hs_bindgen_c1afad204f639896 = fromBaseForeignType hs_bindgen_c1afad204f639896_base {-# NOINLINE args_double_ptr #-} {-| __C declaration:__ @args_double@ @@ -6854,11 +9612,17 @@ args_double_ptr :: FunPtr (A -> CDouble -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_double_ptr = unsafePerformIO hs_bindgen_c1afad204f639896 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c7091d8aa6313541" hs_bindgen_c7091d8aa6313541_base :: BaseForeignType (IO (FunPtr (A -> + CBool -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_args_bool1_ptr@ -} -foreign import ccall safe "hs_bindgen_c7091d8aa6313541" hs_bindgen_c7091d8aa6313541 :: IO (FunPtr (A -> - CBool -> - IO Unit)) +hs_bindgen_c7091d8aa6313541 :: IO (FunPtr (A -> CBool -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_args_bool1_ptr@ +-} +hs_bindgen_c7091d8aa6313541 = fromBaseForeignType hs_bindgen_c7091d8aa6313541_base {-# NOINLINE args_bool1_ptr #-} {-| __C declaration:__ @args_bool1@ @@ -6874,11 +9638,18 @@ args_bool1_ptr :: FunPtr (A -> CBool -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_bool1_ptr = unsafePerformIO hs_bindgen_c7091d8aa6313541 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c14722de6f25d3c0" hs_bindgen_c14722de6f25d3c0_base :: BaseForeignType (IO (FunPtr (A -> + Some_struct -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_struct_ptr@ +-} +hs_bindgen_c14722de6f25d3c0 :: IO (FunPtr (A -> + Some_struct -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_struct_ptr@ -} -foreign import ccall safe "hs_bindgen_c14722de6f25d3c0" hs_bindgen_c14722de6f25d3c0 :: IO (FunPtr (A -> - Some_struct -> - IO Unit)) +hs_bindgen_c14722de6f25d3c0 = fromBaseForeignType hs_bindgen_c14722de6f25d3c0_base {-# NOINLINE args_struct_ptr #-} {-| __C declaration:__ @args_struct@ @@ -6894,11 +9665,18 @@ args_struct_ptr :: FunPtr (A -> Some_struct -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_struct_ptr = unsafePerformIO hs_bindgen_c14722de6f25d3c0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a94ca07a5083d898" hs_bindgen_a94ca07a5083d898_base :: BaseForeignType (IO (FunPtr (A -> + Some_union -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_union_ptr@ +-} +hs_bindgen_a94ca07a5083d898 :: IO (FunPtr (A -> + Some_union -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_union_ptr@ -} -foreign import ccall safe "hs_bindgen_a94ca07a5083d898" hs_bindgen_a94ca07a5083d898 :: IO (FunPtr (A -> - Some_union -> - IO Unit)) +hs_bindgen_a94ca07a5083d898 = fromBaseForeignType hs_bindgen_a94ca07a5083d898_base {-# NOINLINE args_union_ptr #-} {-| __C declaration:__ @args_union@ @@ -6914,11 +9692,18 @@ args_union_ptr :: FunPtr (A -> Some_union -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_union_ptr = unsafePerformIO hs_bindgen_a94ca07a5083d898 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2fdbcc2976b884f7" hs_bindgen_2fdbcc2976b884f7_base :: BaseForeignType (IO (FunPtr (A -> + Some_enum -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_enum_ptr@ +-} +hs_bindgen_2fdbcc2976b884f7 :: IO (FunPtr (A -> + Some_enum -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_enum_ptr@ -} -foreign import ccall safe "hs_bindgen_2fdbcc2976b884f7" hs_bindgen_2fdbcc2976b884f7 :: IO (FunPtr (A -> - Some_enum -> - IO Unit)) +hs_bindgen_2fdbcc2976b884f7 = fromBaseForeignType hs_bindgen_2fdbcc2976b884f7_base {-# NOINLINE args_enum_ptr #-} {-| __C declaration:__ @args_enum@ @@ -6934,11 +9719,18 @@ args_enum_ptr :: FunPtr (A -> Some_enum -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_enum_ptr = unsafePerformIO hs_bindgen_2fdbcc2976b884f7 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_65b8da715d77e581" hs_bindgen_65b8da715d77e581_base :: BaseForeignType (IO (FunPtr (A -> + Ptr CInt -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_args_pointer1_ptr@ -} -foreign import ccall safe "hs_bindgen_65b8da715d77e581" hs_bindgen_65b8da715d77e581 :: IO (FunPtr (A -> - Ptr CInt -> - IO Unit)) +hs_bindgen_65b8da715d77e581 :: IO (FunPtr (A -> + Ptr CInt -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_args_pointer1_ptr@ +-} +hs_bindgen_65b8da715d77e581 = fromBaseForeignType hs_bindgen_65b8da715d77e581_base {-# NOINLINE args_pointer1_ptr #-} {-| __C declaration:__ @args_pointer1@ @@ -6954,11 +9746,18 @@ args_pointer1_ptr :: FunPtr (A -> Ptr CInt -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_pointer1_ptr = unsafePerformIO hs_bindgen_65b8da715d77e581 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_767fe5b679ba43e4" hs_bindgen_767fe5b679ba43e4_base :: BaseForeignType (IO (FunPtr (A -> + Ptr (Ptr CInt) -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_pointer2_ptr@ +-} +hs_bindgen_767fe5b679ba43e4 :: IO (FunPtr (A -> + Ptr (Ptr CInt) -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_pointer2_ptr@ -} -foreign import ccall safe "hs_bindgen_767fe5b679ba43e4" hs_bindgen_767fe5b679ba43e4 :: IO (FunPtr (A -> - Ptr (Ptr CInt) -> - IO Unit)) +hs_bindgen_767fe5b679ba43e4 = fromBaseForeignType hs_bindgen_767fe5b679ba43e4_base {-# NOINLINE args_pointer2_ptr #-} {-| __C declaration:__ @args_pointer2@ @@ -6974,11 +9773,18 @@ args_pointer2_ptr :: FunPtr (A -> Ptr (Ptr CInt) -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_pointer2_ptr = unsafePerformIO hs_bindgen_767fe5b679ba43e4 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_852cc5784297324b" hs_bindgen_852cc5784297324b_base :: BaseForeignType (IO (FunPtr (A -> + Ptr Void -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_pointer3_ptr@ +-} +hs_bindgen_852cc5784297324b :: IO (FunPtr (A -> + Ptr Void -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_pointer3_ptr@ -} -foreign import ccall safe "hs_bindgen_852cc5784297324b" hs_bindgen_852cc5784297324b :: IO (FunPtr (A -> - Ptr Void -> - IO Unit)) +hs_bindgen_852cc5784297324b = fromBaseForeignType hs_bindgen_852cc5784297324b_base {-# NOINLINE args_pointer3_ptr #-} {-| __C declaration:__ @args_pointer3@ @@ -6994,9 +9800,15 @@ args_pointer3_ptr :: FunPtr (A -> Ptr Void -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_pointer3_ptr = unsafePerformIO hs_bindgen_852cc5784297324b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_89cbc210fb67bc53" hs_bindgen_89cbc210fb67bc53_base :: BaseForeignType (IO (FunPtr (IO A))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_A_ptr@ +-} +hs_bindgen_89cbc210fb67bc53 :: IO (FunPtr (IO A)) {-| __unique:__ @test_macrosreparse_Example_get_ret_A_ptr@ -} -foreign import ccall safe "hs_bindgen_89cbc210fb67bc53" hs_bindgen_89cbc210fb67bc53 :: IO (FunPtr (IO A)) +hs_bindgen_89cbc210fb67bc53 = fromBaseForeignType hs_bindgen_89cbc210fb67bc53_base {-# NOINLINE ret_A_ptr #-} {-| __C declaration:__ @ret_A@ @@ -7012,10 +9824,16 @@ ret_A_ptr :: FunPtr (IO A) __exported by:__ @macros\/reparse.h@ -} ret_A_ptr = unsafePerformIO hs_bindgen_89cbc210fb67bc53 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d95a16b3f46326f5" hs_bindgen_d95a16b3f46326f5_base :: BaseForeignType (IO (FunPtr (A -> + IO CChar))) {-| __unique:__ @test_macrosreparse_Example_get_ret_char1_ptr@ -} -foreign import ccall safe "hs_bindgen_d95a16b3f46326f5" hs_bindgen_d95a16b3f46326f5 :: IO (FunPtr (A -> - IO CChar)) +hs_bindgen_d95a16b3f46326f5 :: IO (FunPtr (A -> IO CChar)) +{-| __unique:__ @test_macrosreparse_Example_get_ret_char1_ptr@ +-} +hs_bindgen_d95a16b3f46326f5 = fromBaseForeignType hs_bindgen_d95a16b3f46326f5_base {-# NOINLINE ret_char1_ptr #-} {-| __C declaration:__ @ret_char1@ @@ -7031,10 +9849,16 @@ ret_char1_ptr :: FunPtr (A -> IO CChar) __exported by:__ @macros\/reparse.h@ -} ret_char1_ptr = unsafePerformIO hs_bindgen_d95a16b3f46326f5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dbb14b4445c045dc" hs_bindgen_dbb14b4445c045dc_base :: BaseForeignType (IO (FunPtr (A -> + IO CSChar))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_char2_ptr@ +-} +hs_bindgen_dbb14b4445c045dc :: IO (FunPtr (A -> IO CSChar)) {-| __unique:__ @test_macrosreparse_Example_get_ret_char2_ptr@ -} -foreign import ccall safe "hs_bindgen_dbb14b4445c045dc" hs_bindgen_dbb14b4445c045dc :: IO (FunPtr (A -> - IO CSChar)) +hs_bindgen_dbb14b4445c045dc = fromBaseForeignType hs_bindgen_dbb14b4445c045dc_base {-# NOINLINE ret_char2_ptr #-} {-| __C declaration:__ @ret_char2@ @@ -7050,10 +9874,16 @@ ret_char2_ptr :: FunPtr (A -> IO CSChar) __exported by:__ @macros\/reparse.h@ -} ret_char2_ptr = unsafePerformIO hs_bindgen_dbb14b4445c045dc +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_18d70300449e2a05" hs_bindgen_18d70300449e2a05_base :: BaseForeignType (IO (FunPtr (A -> + IO CUChar))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_char3_ptr@ +-} +hs_bindgen_18d70300449e2a05 :: IO (FunPtr (A -> IO CUChar)) {-| __unique:__ @test_macrosreparse_Example_get_ret_char3_ptr@ -} -foreign import ccall safe "hs_bindgen_18d70300449e2a05" hs_bindgen_18d70300449e2a05 :: IO (FunPtr (A -> - IO CUChar)) +hs_bindgen_18d70300449e2a05 = fromBaseForeignType hs_bindgen_18d70300449e2a05_base {-# NOINLINE ret_char3_ptr #-} {-| __C declaration:__ @ret_char3@ @@ -7069,10 +9899,16 @@ ret_char3_ptr :: FunPtr (A -> IO CUChar) __exported by:__ @macros\/reparse.h@ -} ret_char3_ptr = unsafePerformIO hs_bindgen_18d70300449e2a05 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7f113070dda67da8" hs_bindgen_7f113070dda67da8_base :: BaseForeignType (IO (FunPtr (A -> + IO CShort))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_short1_ptr@ +-} +hs_bindgen_7f113070dda67da8 :: IO (FunPtr (A -> IO CShort)) {-| __unique:__ @test_macrosreparse_Example_get_ret_short1_ptr@ -} -foreign import ccall safe "hs_bindgen_7f113070dda67da8" hs_bindgen_7f113070dda67da8 :: IO (FunPtr (A -> - IO CShort)) +hs_bindgen_7f113070dda67da8 = fromBaseForeignType hs_bindgen_7f113070dda67da8_base {-# NOINLINE ret_short1_ptr #-} {-| __C declaration:__ @ret_short1@ @@ -7088,10 +9924,16 @@ ret_short1_ptr :: FunPtr (A -> IO CShort) __exported by:__ @macros\/reparse.h@ -} ret_short1_ptr = unsafePerformIO hs_bindgen_7f113070dda67da8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_601d9c0a30f1855b" hs_bindgen_601d9c0a30f1855b_base :: BaseForeignType (IO (FunPtr (A -> + IO CShort))) {-| __unique:__ @test_macrosreparse_Example_get_ret_short2_ptr@ -} -foreign import ccall safe "hs_bindgen_601d9c0a30f1855b" hs_bindgen_601d9c0a30f1855b :: IO (FunPtr (A -> - IO CShort)) +hs_bindgen_601d9c0a30f1855b :: IO (FunPtr (A -> IO CShort)) +{-| __unique:__ @test_macrosreparse_Example_get_ret_short2_ptr@ +-} +hs_bindgen_601d9c0a30f1855b = fromBaseForeignType hs_bindgen_601d9c0a30f1855b_base {-# NOINLINE ret_short2_ptr #-} {-| __C declaration:__ @ret_short2@ @@ -7107,10 +9949,16 @@ ret_short2_ptr :: FunPtr (A -> IO CShort) __exported by:__ @macros\/reparse.h@ -} ret_short2_ptr = unsafePerformIO hs_bindgen_601d9c0a30f1855b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_eb1f70424e0c701d" hs_bindgen_eb1f70424e0c701d_base :: BaseForeignType (IO (FunPtr (A -> + IO CUShort))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_short3_ptr@ +-} +hs_bindgen_eb1f70424e0c701d :: IO (FunPtr (A -> IO CUShort)) {-| __unique:__ @test_macrosreparse_Example_get_ret_short3_ptr@ -} -foreign import ccall safe "hs_bindgen_eb1f70424e0c701d" hs_bindgen_eb1f70424e0c701d :: IO (FunPtr (A -> - IO CUShort)) +hs_bindgen_eb1f70424e0c701d = fromBaseForeignType hs_bindgen_eb1f70424e0c701d_base {-# NOINLINE ret_short3_ptr #-} {-| __C declaration:__ @ret_short3@ @@ -7125,11 +9973,17 @@ ret_short3_ptr :: FunPtr (A -> IO CUShort) __exported by:__ @macros\/reparse.h@ -} -ret_short3_ptr = unsafePerformIO hs_bindgen_eb1f70424e0c701d +ret_short3_ptr = unsafePerformIO hs_bindgen_eb1f70424e0c701d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_28a93ce9f2a99cd0" hs_bindgen_28a93ce9f2a99cd0_base :: BaseForeignType (IO (FunPtr (A -> + IO CInt))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_int1_ptr@ +-} +hs_bindgen_28a93ce9f2a99cd0 :: IO (FunPtr (A -> IO CInt)) {-| __unique:__ @test_macrosreparse_Example_get_ret_int1_ptr@ -} -foreign import ccall safe "hs_bindgen_28a93ce9f2a99cd0" hs_bindgen_28a93ce9f2a99cd0 :: IO (FunPtr (A -> - IO CInt)) +hs_bindgen_28a93ce9f2a99cd0 = fromBaseForeignType hs_bindgen_28a93ce9f2a99cd0_base {-# NOINLINE ret_int1_ptr #-} {-| __C declaration:__ @ret_int1@ @@ -7145,10 +9999,16 @@ ret_int1_ptr :: FunPtr (A -> IO CInt) __exported by:__ @macros\/reparse.h@ -} ret_int1_ptr = unsafePerformIO hs_bindgen_28a93ce9f2a99cd0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a70295d21f766087" hs_bindgen_a70295d21f766087_base :: BaseForeignType (IO (FunPtr (A -> + IO CInt))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_int2_ptr@ +-} +hs_bindgen_a70295d21f766087 :: IO (FunPtr (A -> IO CInt)) {-| __unique:__ @test_macrosreparse_Example_get_ret_int2_ptr@ -} -foreign import ccall safe "hs_bindgen_a70295d21f766087" hs_bindgen_a70295d21f766087 :: IO (FunPtr (A -> - IO CInt)) +hs_bindgen_a70295d21f766087 = fromBaseForeignType hs_bindgen_a70295d21f766087_base {-# NOINLINE ret_int2_ptr #-} {-| __C declaration:__ @ret_int2@ @@ -7164,10 +10024,16 @@ ret_int2_ptr :: FunPtr (A -> IO CInt) __exported by:__ @macros\/reparse.h@ -} ret_int2_ptr = unsafePerformIO hs_bindgen_a70295d21f766087 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4239c3dd15ab11f3" hs_bindgen_4239c3dd15ab11f3_base :: BaseForeignType (IO (FunPtr (A -> + IO CUInt))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_int3_ptr@ +-} +hs_bindgen_4239c3dd15ab11f3 :: IO (FunPtr (A -> IO CUInt)) {-| __unique:__ @test_macrosreparse_Example_get_ret_int3_ptr@ -} -foreign import ccall safe "hs_bindgen_4239c3dd15ab11f3" hs_bindgen_4239c3dd15ab11f3 :: IO (FunPtr (A -> - IO CUInt)) +hs_bindgen_4239c3dd15ab11f3 = fromBaseForeignType hs_bindgen_4239c3dd15ab11f3_base {-# NOINLINE ret_int3_ptr #-} {-| __C declaration:__ @ret_int3@ @@ -7183,10 +10049,16 @@ ret_int3_ptr :: FunPtr (A -> IO CUInt) __exported by:__ @macros\/reparse.h@ -} ret_int3_ptr = unsafePerformIO hs_bindgen_4239c3dd15ab11f3 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b24935761b06cfd8" hs_bindgen_b24935761b06cfd8_base :: BaseForeignType (IO (FunPtr (A -> + IO CLong))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_long1_ptr@ +-} +hs_bindgen_b24935761b06cfd8 :: IO (FunPtr (A -> IO CLong)) {-| __unique:__ @test_macrosreparse_Example_get_ret_long1_ptr@ -} -foreign import ccall safe "hs_bindgen_b24935761b06cfd8" hs_bindgen_b24935761b06cfd8 :: IO (FunPtr (A -> - IO CLong)) +hs_bindgen_b24935761b06cfd8 = fromBaseForeignType hs_bindgen_b24935761b06cfd8_base {-# NOINLINE ret_long1_ptr #-} {-| __C declaration:__ @ret_long1@ @@ -7202,10 +10074,16 @@ ret_long1_ptr :: FunPtr (A -> IO CLong) __exported by:__ @macros\/reparse.h@ -} ret_long1_ptr = unsafePerformIO hs_bindgen_b24935761b06cfd8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_35a17cc5266d3326" hs_bindgen_35a17cc5266d3326_base :: BaseForeignType (IO (FunPtr (A -> + IO CLong))) {-| __unique:__ @test_macrosreparse_Example_get_ret_long2_ptr@ -} -foreign import ccall safe "hs_bindgen_35a17cc5266d3326" hs_bindgen_35a17cc5266d3326 :: IO (FunPtr (A -> - IO CLong)) +hs_bindgen_35a17cc5266d3326 :: IO (FunPtr (A -> IO CLong)) +{-| __unique:__ @test_macrosreparse_Example_get_ret_long2_ptr@ +-} +hs_bindgen_35a17cc5266d3326 = fromBaseForeignType hs_bindgen_35a17cc5266d3326_base {-# NOINLINE ret_long2_ptr #-} {-| __C declaration:__ @ret_long2@ @@ -7221,10 +10099,16 @@ ret_long2_ptr :: FunPtr (A -> IO CLong) __exported by:__ @macros\/reparse.h@ -} ret_long2_ptr = unsafePerformIO hs_bindgen_35a17cc5266d3326 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_59489620015c271e" hs_bindgen_59489620015c271e_base :: BaseForeignType (IO (FunPtr (A -> + IO CULong))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_long3_ptr@ +-} +hs_bindgen_59489620015c271e :: IO (FunPtr (A -> IO CULong)) {-| __unique:__ @test_macrosreparse_Example_get_ret_long3_ptr@ -} -foreign import ccall safe "hs_bindgen_59489620015c271e" hs_bindgen_59489620015c271e :: IO (FunPtr (A -> - IO CULong)) +hs_bindgen_59489620015c271e = fromBaseForeignType hs_bindgen_59489620015c271e_base {-# NOINLINE ret_long3_ptr #-} {-| __C declaration:__ @ret_long3@ @@ -7240,10 +10124,16 @@ ret_long3_ptr :: FunPtr (A -> IO CULong) __exported by:__ @macros\/reparse.h@ -} ret_long3_ptr = unsafePerformIO hs_bindgen_59489620015c271e +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_52138c45b539427d" hs_bindgen_52138c45b539427d_base :: BaseForeignType (IO (FunPtr (A -> + IO CFloat))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_float_ptr@ +-} +hs_bindgen_52138c45b539427d :: IO (FunPtr (A -> IO CFloat)) {-| __unique:__ @test_macrosreparse_Example_get_ret_float_ptr@ -} -foreign import ccall safe "hs_bindgen_52138c45b539427d" hs_bindgen_52138c45b539427d :: IO (FunPtr (A -> - IO CFloat)) +hs_bindgen_52138c45b539427d = fromBaseForeignType hs_bindgen_52138c45b539427d_base {-# NOINLINE ret_float_ptr #-} {-| __C declaration:__ @ret_float@ @@ -7259,10 +10149,16 @@ ret_float_ptr :: FunPtr (A -> IO CFloat) __exported by:__ @macros\/reparse.h@ -} ret_float_ptr = unsafePerformIO hs_bindgen_52138c45b539427d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_283d5d098a9c4a59" hs_bindgen_283d5d098a9c4a59_base :: BaseForeignType (IO (FunPtr (A -> + IO CDouble))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_double_ptr@ +-} +hs_bindgen_283d5d098a9c4a59 :: IO (FunPtr (A -> IO CDouble)) {-| __unique:__ @test_macrosreparse_Example_get_ret_double_ptr@ -} -foreign import ccall safe "hs_bindgen_283d5d098a9c4a59" hs_bindgen_283d5d098a9c4a59 :: IO (FunPtr (A -> - IO CDouble)) +hs_bindgen_283d5d098a9c4a59 = fromBaseForeignType hs_bindgen_283d5d098a9c4a59_base {-# NOINLINE ret_double_ptr #-} {-| __C declaration:__ @ret_double@ @@ -7278,10 +10174,16 @@ ret_double_ptr :: FunPtr (A -> IO CDouble) __exported by:__ @macros\/reparse.h@ -} ret_double_ptr = unsafePerformIO hs_bindgen_283d5d098a9c4a59 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_382098412cbd94ff" hs_bindgen_382098412cbd94ff_base :: BaseForeignType (IO (FunPtr (A -> + IO CBool))) {-| __unique:__ @test_macrosreparse_Example_get_ret_bool1_ptr@ -} -foreign import ccall safe "hs_bindgen_382098412cbd94ff" hs_bindgen_382098412cbd94ff :: IO (FunPtr (A -> - IO CBool)) +hs_bindgen_382098412cbd94ff :: IO (FunPtr (A -> IO CBool)) +{-| __unique:__ @test_macrosreparse_Example_get_ret_bool1_ptr@ +-} +hs_bindgen_382098412cbd94ff = fromBaseForeignType hs_bindgen_382098412cbd94ff_base {-# NOINLINE ret_bool1_ptr #-} {-| __C declaration:__ @ret_bool1@ @@ -7297,10 +10199,16 @@ ret_bool1_ptr :: FunPtr (A -> IO CBool) __exported by:__ @macros\/reparse.h@ -} ret_bool1_ptr = unsafePerformIO hs_bindgen_382098412cbd94ff +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_51cf9857b3cc1843" hs_bindgen_51cf9857b3cc1843_base :: BaseForeignType (IO (FunPtr (A -> + IO Some_struct))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_struct_ptr@ +-} +hs_bindgen_51cf9857b3cc1843 :: IO (FunPtr (A -> IO Some_struct)) {-| __unique:__ @test_macrosreparse_Example_get_ret_struct_ptr@ -} -foreign import ccall safe "hs_bindgen_51cf9857b3cc1843" hs_bindgen_51cf9857b3cc1843 :: IO (FunPtr (A -> - IO Some_struct)) +hs_bindgen_51cf9857b3cc1843 = fromBaseForeignType hs_bindgen_51cf9857b3cc1843_base {-# NOINLINE ret_struct_ptr #-} {-| __C declaration:__ @ret_struct@ @@ -7316,10 +10224,16 @@ ret_struct_ptr :: FunPtr (A -> IO Some_struct) __exported by:__ @macros\/reparse.h@ -} ret_struct_ptr = unsafePerformIO hs_bindgen_51cf9857b3cc1843 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3df1073dbf5d79f4" hs_bindgen_3df1073dbf5d79f4_base :: BaseForeignType (IO (FunPtr (A -> + IO Some_union))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_union_ptr@ +-} +hs_bindgen_3df1073dbf5d79f4 :: IO (FunPtr (A -> IO Some_union)) {-| __unique:__ @test_macrosreparse_Example_get_ret_union_ptr@ -} -foreign import ccall safe "hs_bindgen_3df1073dbf5d79f4" hs_bindgen_3df1073dbf5d79f4 :: IO (FunPtr (A -> - IO Some_union)) +hs_bindgen_3df1073dbf5d79f4 = fromBaseForeignType hs_bindgen_3df1073dbf5d79f4_base {-# NOINLINE ret_union_ptr #-} {-| __C declaration:__ @ret_union@ @@ -7335,10 +10249,16 @@ ret_union_ptr :: FunPtr (A -> IO Some_union) __exported by:__ @macros\/reparse.h@ -} ret_union_ptr = unsafePerformIO hs_bindgen_3df1073dbf5d79f4 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c0467f7279732ddd" hs_bindgen_c0467f7279732ddd_base :: BaseForeignType (IO (FunPtr (A -> + IO Some_enum))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_enum_ptr@ +-} +hs_bindgen_c0467f7279732ddd :: IO (FunPtr (A -> IO Some_enum)) {-| __unique:__ @test_macrosreparse_Example_get_ret_enum_ptr@ -} -foreign import ccall safe "hs_bindgen_c0467f7279732ddd" hs_bindgen_c0467f7279732ddd :: IO (FunPtr (A -> - IO Some_enum)) +hs_bindgen_c0467f7279732ddd = fromBaseForeignType hs_bindgen_c0467f7279732ddd_base {-# NOINLINE ret_enum_ptr #-} {-| __C declaration:__ @ret_enum@ @@ -7354,10 +10274,16 @@ ret_enum_ptr :: FunPtr (A -> IO Some_enum) __exported by:__ @macros\/reparse.h@ -} ret_enum_ptr = unsafePerformIO hs_bindgen_c0467f7279732ddd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f0240baaa70df9bd" hs_bindgen_f0240baaa70df9bd_base :: BaseForeignType (IO (FunPtr (A -> + IO (Ptr CInt)))) {-| __unique:__ @test_macrosreparse_Example_get_ret_pointer1_ptr@ -} -foreign import ccall safe "hs_bindgen_f0240baaa70df9bd" hs_bindgen_f0240baaa70df9bd :: IO (FunPtr (A -> - IO (Ptr CInt))) +hs_bindgen_f0240baaa70df9bd :: IO (FunPtr (A -> IO (Ptr CInt))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_pointer1_ptr@ +-} +hs_bindgen_f0240baaa70df9bd = fromBaseForeignType hs_bindgen_f0240baaa70df9bd_base {-# NOINLINE ret_pointer1_ptr #-} {-| __C declaration:__ @ret_pointer1@ @@ -7373,10 +10299,17 @@ ret_pointer1_ptr :: FunPtr (A -> IO (Ptr CInt)) __exported by:__ @macros\/reparse.h@ -} ret_pointer1_ptr = unsafePerformIO hs_bindgen_f0240baaa70df9bd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_019cbfb4d24d1d91" hs_bindgen_019cbfb4d24d1d91_base :: BaseForeignType (IO (FunPtr (A -> + IO (Ptr (Ptr CInt))))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_pointer2_ptr@ +-} +hs_bindgen_019cbfb4d24d1d91 :: IO (FunPtr (A -> + IO (Ptr (Ptr CInt)))) {-| __unique:__ @test_macrosreparse_Example_get_ret_pointer2_ptr@ -} -foreign import ccall safe "hs_bindgen_019cbfb4d24d1d91" hs_bindgen_019cbfb4d24d1d91 :: IO (FunPtr (A -> - IO (Ptr (Ptr CInt)))) +hs_bindgen_019cbfb4d24d1d91 = fromBaseForeignType hs_bindgen_019cbfb4d24d1d91_base {-# NOINLINE ret_pointer2_ptr #-} {-| __C declaration:__ @ret_pointer2@ @@ -7392,10 +10325,16 @@ ret_pointer2_ptr :: FunPtr (A -> IO (Ptr (Ptr CInt))) __exported by:__ @macros\/reparse.h@ -} ret_pointer2_ptr = unsafePerformIO hs_bindgen_019cbfb4d24d1d91 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a654e9f8ca0d53c5" hs_bindgen_a654e9f8ca0d53c5_base :: BaseForeignType (IO (FunPtr (A -> + IO (Ptr Void)))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_pointer3_ptr@ +-} +hs_bindgen_a654e9f8ca0d53c5 :: IO (FunPtr (A -> IO (Ptr Void))) {-| __unique:__ @test_macrosreparse_Example_get_ret_pointer3_ptr@ -} -foreign import ccall safe "hs_bindgen_a654e9f8ca0d53c5" hs_bindgen_a654e9f8ca0d53c5 :: IO (FunPtr (A -> - IO (Ptr Void))) +hs_bindgen_a654e9f8ca0d53c5 = fromBaseForeignType hs_bindgen_a654e9f8ca0d53c5_base {-# NOINLINE ret_pointer3_ptr #-} {-| __C declaration:__ @ret_pointer3@ @@ -7411,10 +10350,16 @@ ret_pointer3_ptr :: FunPtr (A -> IO (Ptr Void)) __exported by:__ @macros\/reparse.h@ -} ret_pointer3_ptr = unsafePerformIO hs_bindgen_a654e9f8ca0d53c5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_94eff7815581584b" hs_bindgen_94eff7815581584b_base :: BaseForeignType (IO (FunPtr (A -> + IO CInt))) +{-| __unique:__ @test_macrosreparse_Example_get_body1_ptr@ +-} +hs_bindgen_94eff7815581584b :: IO (FunPtr (A -> IO CInt)) {-| __unique:__ @test_macrosreparse_Example_get_body1_ptr@ -} -foreign import ccall safe "hs_bindgen_94eff7815581584b" hs_bindgen_94eff7815581584b :: IO (FunPtr (A -> - IO CInt)) +hs_bindgen_94eff7815581584b = fromBaseForeignType hs_bindgen_94eff7815581584b_base {-# NOINLINE body1_ptr #-} {-| __C declaration:__ @body1@ @@ -7430,9 +10375,15 @@ body1_ptr :: FunPtr (A -> IO CInt) __exported by:__ @macros\/reparse.h@ -} body1_ptr = unsafePerformIO hs_bindgen_94eff7815581584b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f98b0963b05f261c" hs_bindgen_f98b0963b05f261c_base :: BaseForeignType (IO (FunPtr (IO A))) {-| __unique:__ @test_macrosreparse_Example_get_body2_ptr@ -} -foreign import ccall safe "hs_bindgen_f98b0963b05f261c" hs_bindgen_f98b0963b05f261c :: IO (FunPtr (IO A)) +hs_bindgen_f98b0963b05f261c :: IO (FunPtr (IO A)) +{-| __unique:__ @test_macrosreparse_Example_get_body2_ptr@ +-} +hs_bindgen_f98b0963b05f261c = fromBaseForeignType hs_bindgen_f98b0963b05f261c_base {-# NOINLINE body2_ptr #-} {-| __C declaration:__ @body2@ @@ -7448,11 +10399,18 @@ body2_ptr :: FunPtr (IO A) __exported by:__ @macros\/reparse.h@ -} body2_ptr = unsafePerformIO hs_bindgen_f98b0963b05f261c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e2f3985767c79559" hs_bindgen_e2f3985767c79559_base :: BaseForeignType (IO (FunPtr (A -> + Complex CFloat -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_complex_float_ptr@ +-} +hs_bindgen_e2f3985767c79559 :: IO (FunPtr (A -> + Complex CFloat -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_complex_float_ptr@ -} -foreign import ccall safe "hs_bindgen_e2f3985767c79559" hs_bindgen_e2f3985767c79559 :: IO (FunPtr (A -> - Complex CFloat -> - IO Unit)) +hs_bindgen_e2f3985767c79559 = fromBaseForeignType hs_bindgen_e2f3985767c79559_base {-# NOINLINE args_complex_float_ptr #-} {-| __C declaration:__ @args_complex_float@ @@ -7468,11 +10426,18 @@ args_complex_float_ptr :: FunPtr (A -> Complex CFloat -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_complex_float_ptr = unsafePerformIO hs_bindgen_e2f3985767c79559 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1da23b0894c2e548" hs_bindgen_1da23b0894c2e548_base :: BaseForeignType (IO (FunPtr (A -> + Complex CDouble -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_args_complex_double_ptr@ +-} +hs_bindgen_1da23b0894c2e548 :: IO (FunPtr (A -> + Complex CDouble -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_args_complex_double_ptr@ -} -foreign import ccall safe "hs_bindgen_1da23b0894c2e548" hs_bindgen_1da23b0894c2e548 :: IO (FunPtr (A -> - Complex CDouble -> - IO Unit)) +hs_bindgen_1da23b0894c2e548 = fromBaseForeignType hs_bindgen_1da23b0894c2e548_base {-# NOINLINE args_complex_double_ptr #-} {-| __C declaration:__ @args_complex_double@ @@ -7488,10 +10453,17 @@ args_complex_double_ptr :: FunPtr (A -> Complex CDouble -> IO Unit) __exported by:__ @macros\/reparse.h@ -} args_complex_double_ptr = unsafePerformIO hs_bindgen_1da23b0894c2e548 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e3d89b51410d7614" hs_bindgen_e3d89b51410d7614_base :: BaseForeignType (IO (FunPtr (A -> + IO (Complex CFloat)))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_complex_float_ptr@ +-} +hs_bindgen_e3d89b51410d7614 :: IO (FunPtr (A -> + IO (Complex CFloat))) {-| __unique:__ @test_macrosreparse_Example_get_ret_complex_float_ptr@ -} -foreign import ccall safe "hs_bindgen_e3d89b51410d7614" hs_bindgen_e3d89b51410d7614 :: IO (FunPtr (A -> - IO (Complex CFloat))) +hs_bindgen_e3d89b51410d7614 = fromBaseForeignType hs_bindgen_e3d89b51410d7614_base {-# NOINLINE ret_complex_float_ptr #-} {-| __C declaration:__ @ret_complex_float@ @@ -7507,10 +10479,17 @@ ret_complex_float_ptr :: FunPtr (A -> IO (Complex CFloat)) __exported by:__ @macros\/reparse.h@ -} ret_complex_float_ptr = unsafePerformIO hs_bindgen_e3d89b51410d7614 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7cc277a18abf87b8" hs_bindgen_7cc277a18abf87b8_base :: BaseForeignType (IO (FunPtr (A -> + IO (Complex CDouble)))) {-| __unique:__ @test_macrosreparse_Example_get_ret_complex_double_ptr@ -} -foreign import ccall safe "hs_bindgen_7cc277a18abf87b8" hs_bindgen_7cc277a18abf87b8 :: IO (FunPtr (A -> - IO (Complex CDouble))) +hs_bindgen_7cc277a18abf87b8 :: IO (FunPtr (A -> + IO (Complex CDouble))) +{-| __unique:__ @test_macrosreparse_Example_get_ret_complex_double_ptr@ +-} +hs_bindgen_7cc277a18abf87b8 = fromBaseForeignType hs_bindgen_7cc277a18abf87b8_base {-# NOINLINE ret_complex_double_ptr #-} {-| __C declaration:__ @ret_complex_double@ @@ -7526,11 +10505,17 @@ ret_complex_double_ptr :: FunPtr (A -> IO (Complex CDouble)) __exported by:__ @macros\/reparse.h@ -} ret_complex_double_ptr = unsafePerformIO hs_bindgen_7cc277a18abf87b8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_764ddaf3efe7bd53" hs_bindgen_764ddaf3efe7bd53_base :: BaseForeignType (IO (FunPtr (A -> + CBool -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_bespoke_args1_ptr@ +-} +hs_bindgen_764ddaf3efe7bd53 :: IO (FunPtr (A -> CBool -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_bespoke_args1_ptr@ -} -foreign import ccall safe "hs_bindgen_764ddaf3efe7bd53" hs_bindgen_764ddaf3efe7bd53 :: IO (FunPtr (A -> - CBool -> - IO Unit)) +hs_bindgen_764ddaf3efe7bd53 = fromBaseForeignType hs_bindgen_764ddaf3efe7bd53_base {-# NOINLINE bespoke_args1_ptr #-} {-| __C declaration:__ @bespoke_args1@ @@ -7546,11 +10531,18 @@ bespoke_args1_ptr :: FunPtr (A -> CBool -> IO Unit) __exported by:__ @macros\/reparse.h@ -} bespoke_args1_ptr = unsafePerformIO hs_bindgen_764ddaf3efe7bd53 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_53ccc1b308cd8384" hs_bindgen_53ccc1b308cd8384_base :: BaseForeignType (IO (FunPtr (A -> + HsBindgen.Runtime.Prelude.CSize -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_bespoke_args2_ptr@ +-} +hs_bindgen_53ccc1b308cd8384 :: IO (FunPtr (A -> + HsBindgen.Runtime.Prelude.CSize -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_bespoke_args2_ptr@ -} -foreign import ccall safe "hs_bindgen_53ccc1b308cd8384" hs_bindgen_53ccc1b308cd8384 :: IO (FunPtr (A -> - HsBindgen.Runtime.Prelude.CSize -> - IO Unit)) +hs_bindgen_53ccc1b308cd8384 = fromBaseForeignType hs_bindgen_53ccc1b308cd8384_base {-# NOINLINE bespoke_args2_ptr #-} {-| __C declaration:__ @bespoke_args2@ @@ -7567,10 +10559,16 @@ bespoke_args2_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} bespoke_args2_ptr = unsafePerformIO hs_bindgen_53ccc1b308cd8384 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e61f250910ddc098" hs_bindgen_e61f250910ddc098_base :: BaseForeignType (IO (FunPtr (A -> + IO CBool))) +{-| __unique:__ @test_macrosreparse_Example_get_bespoke_ret1_ptr@ +-} +hs_bindgen_e61f250910ddc098 :: IO (FunPtr (A -> IO CBool)) {-| __unique:__ @test_macrosreparse_Example_get_bespoke_ret1_ptr@ -} -foreign import ccall safe "hs_bindgen_e61f250910ddc098" hs_bindgen_e61f250910ddc098 :: IO (FunPtr (A -> - IO CBool)) +hs_bindgen_e61f250910ddc098 = fromBaseForeignType hs_bindgen_e61f250910ddc098_base {-# NOINLINE bespoke_ret1_ptr #-} {-| __C declaration:__ @bespoke_ret1@ @@ -7586,10 +10584,17 @@ bespoke_ret1_ptr :: FunPtr (A -> IO CBool) __exported by:__ @macros\/reparse.h@ -} bespoke_ret1_ptr = unsafePerformIO hs_bindgen_e61f250910ddc098 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b9864dba6e30c078" hs_bindgen_b9864dba6e30c078_base :: BaseForeignType (IO (FunPtr (A -> + IO HsBindgen.Runtime.Prelude.CSize))) {-| __unique:__ @test_macrosreparse_Example_get_bespoke_ret2_ptr@ -} -foreign import ccall safe "hs_bindgen_b9864dba6e30c078" hs_bindgen_b9864dba6e30c078 :: IO (FunPtr (A -> - IO HsBindgen.Runtime.Prelude.CSize)) +hs_bindgen_b9864dba6e30c078 :: IO (FunPtr (A -> + IO HsBindgen.Runtime.Prelude.CSize)) +{-| __unique:__ @test_macrosreparse_Example_get_bespoke_ret2_ptr@ +-} +hs_bindgen_b9864dba6e30c078 = fromBaseForeignType hs_bindgen_b9864dba6e30c078_base {-# NOINLINE bespoke_ret2_ptr #-} {-| __C declaration:__ @bespoke_ret2@ @@ -7606,10 +10611,17 @@ bespoke_ret2_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} bespoke_ret2_ptr = unsafePerformIO hs_bindgen_b9864dba6e30c078 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bb7f94a203c14e76" hs_bindgen_bb7f94a203c14e76_base :: BaseForeignType (IO (FunPtr (IncompleteArray A -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_arr_args1_ptr@ +-} +hs_bindgen_bb7f94a203c14e76 :: IO (FunPtr (IncompleteArray A -> + IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_arr_args1_ptr@ -} -foreign import ccall safe "hs_bindgen_bb7f94a203c14e76" hs_bindgen_bb7f94a203c14e76 :: IO (FunPtr (IncompleteArray A -> - IO Unit)) +hs_bindgen_bb7f94a203c14e76 = fromBaseForeignType hs_bindgen_bb7f94a203c14e76_base {-# NOINLINE arr_args1_ptr #-} {-| Arrays @@ -7629,10 +10641,17 @@ __defined at:__ @macros\/reparse.h:104:6@ __exported by:__ @macros\/reparse.h@ -} arr_args1_ptr = unsafePerformIO hs_bindgen_bb7f94a203c14e76 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ca2476976e4721ef" hs_bindgen_ca2476976e4721ef_base :: BaseForeignType (IO (FunPtr (IncompleteArray (Ptr A) -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_arr_args2_ptr@ +-} +hs_bindgen_ca2476976e4721ef :: IO (FunPtr (IncompleteArray (Ptr A) -> + IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_arr_args2_ptr@ -} -foreign import ccall safe "hs_bindgen_ca2476976e4721ef" hs_bindgen_ca2476976e4721ef :: IO (FunPtr (IncompleteArray (Ptr A) -> - IO Unit)) +hs_bindgen_ca2476976e4721ef = fromBaseForeignType hs_bindgen_ca2476976e4721ef_base {-# NOINLINE arr_args2_ptr #-} {-| __C declaration:__ @arr_args2@ @@ -7648,11 +10667,18 @@ arr_args2_ptr :: FunPtr (IncompleteArray (Ptr A) -> IO Unit) __exported by:__ @macros\/reparse.h@ -} arr_args2_ptr = unsafePerformIO hs_bindgen_ca2476976e4721ef +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3298ac669c00b1cd" hs_bindgen_3298ac669c00b1cd_base :: BaseForeignType (IO (FunPtr (ConstantArray 5 + A -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_arr_args3_ptr@ +-} +hs_bindgen_3298ac669c00b1cd :: IO (FunPtr (ConstantArray 5 A -> + IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_arr_args3_ptr@ -} -foreign import ccall safe "hs_bindgen_3298ac669c00b1cd" hs_bindgen_3298ac669c00b1cd :: IO (FunPtr (ConstantArray 5 - A -> - IO Unit)) +hs_bindgen_3298ac669c00b1cd = fromBaseForeignType hs_bindgen_3298ac669c00b1cd_base {-# NOINLINE arr_args3_ptr #-} {-| __C declaration:__ @arr_args3@ @@ -7668,11 +10694,19 @@ arr_args3_ptr :: FunPtr (ConstantArray 5 A -> IO Unit) __exported by:__ @macros\/reparse.h@ -} arr_args3_ptr = unsafePerformIO hs_bindgen_3298ac669c00b1cd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_329a5d4b44b11e6e" hs_bindgen_329a5d4b44b11e6e_base :: BaseForeignType (IO (FunPtr (ConstantArray 5 + (Ptr A) -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_arr_args4_ptr@ -} -foreign import ccall safe "hs_bindgen_329a5d4b44b11e6e" hs_bindgen_329a5d4b44b11e6e :: IO (FunPtr (ConstantArray 5 - (Ptr A) -> - IO Unit)) +hs_bindgen_329a5d4b44b11e6e :: IO (FunPtr (ConstantArray 5 + (Ptr A) -> + IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_arr_args4_ptr@ +-} +hs_bindgen_329a5d4b44b11e6e = fromBaseForeignType hs_bindgen_329a5d4b44b11e6e_base {-# NOINLINE arr_args4_ptr #-} {-| __C declaration:__ @arr_args4@ @@ -7688,11 +10722,18 @@ arr_args4_ptr :: FunPtr (ConstantArray 5 (Ptr A) -> IO Unit) __exported by:__ @macros\/reparse.h@ -} arr_args4_ptr = unsafePerformIO hs_bindgen_329a5d4b44b11e6e +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dac9e3bdccb6a4eb" hs_bindgen_dac9e3bdccb6a4eb_base :: BaseForeignType (IO (FunPtr (A -> + FunPtr (IO Unit) -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_args1_ptr@ +-} +hs_bindgen_dac9e3bdccb6a4eb :: IO (FunPtr (A -> + FunPtr (IO Unit) -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_funptr_args1_ptr@ -} -foreign import ccall safe "hs_bindgen_dac9e3bdccb6a4eb" hs_bindgen_dac9e3bdccb6a4eb :: IO (FunPtr (A -> - FunPtr (IO Unit) -> - IO Unit)) +hs_bindgen_dac9e3bdccb6a4eb = fromBaseForeignType hs_bindgen_dac9e3bdccb6a4eb_base {-# NOINLINE funptr_args1_ptr #-} {-| Function pointers @@ -7712,11 +10753,18 @@ __defined at:__ @macros\/reparse.h:126:6@ __exported by:__ @macros\/reparse.h@ -} funptr_args1_ptr = unsafePerformIO hs_bindgen_dac9e3bdccb6a4eb +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_83d7f85727e54da4" hs_bindgen_83d7f85727e54da4_base :: BaseForeignType (IO (FunPtr (A -> + FunPtr (IO CInt) -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_args2_ptr@ +-} +hs_bindgen_83d7f85727e54da4 :: IO (FunPtr (A -> + FunPtr (IO CInt) -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_funptr_args2_ptr@ -} -foreign import ccall safe "hs_bindgen_83d7f85727e54da4" hs_bindgen_83d7f85727e54da4 :: IO (FunPtr (A -> - FunPtr (IO CInt) -> - IO Unit)) +hs_bindgen_83d7f85727e54da4 = fromBaseForeignType hs_bindgen_83d7f85727e54da4_base {-# NOINLINE funptr_args2_ptr #-} {-| __C declaration:__ @funptr_args2@ @@ -7732,12 +10780,19 @@ funptr_args2_ptr :: FunPtr (A -> FunPtr (IO CInt) -> IO Unit) __exported by:__ @macros\/reparse.h@ -} funptr_args2_ptr = unsafePerformIO hs_bindgen_83d7f85727e54da4 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_107e06f31f9dd017" hs_bindgen_107e06f31f9dd017_base :: BaseForeignType (IO (FunPtr (A -> + FunPtr (CInt -> + IO Unit) -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_args3_ptr@ +-} +hs_bindgen_107e06f31f9dd017 :: IO (FunPtr (A -> + FunPtr (CInt -> IO Unit) -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_funptr_args3_ptr@ -} -foreign import ccall safe "hs_bindgen_107e06f31f9dd017" hs_bindgen_107e06f31f9dd017 :: IO (FunPtr (A -> - FunPtr (CInt -> - IO Unit) -> - IO Unit)) +hs_bindgen_107e06f31f9dd017 = fromBaseForeignType hs_bindgen_107e06f31f9dd017_base {-# NOINLINE funptr_args3_ptr #-} {-| __C declaration:__ @funptr_args3@ @@ -7754,13 +10809,20 @@ funptr_args3_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} funptr_args3_ptr = unsafePerformIO hs_bindgen_107e06f31f9dd017 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_51a7f0cfbd57eaf7" hs_bindgen_51a7f0cfbd57eaf7_base :: BaseForeignType (IO (FunPtr (A -> + FunPtr (CInt -> + CDouble -> + IO CChar) -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_args4_ptr@ -} -foreign import ccall safe "hs_bindgen_51a7f0cfbd57eaf7" hs_bindgen_51a7f0cfbd57eaf7 :: IO (FunPtr (A -> - FunPtr (CInt -> - CDouble -> - IO CChar) -> - IO Unit)) +hs_bindgen_51a7f0cfbd57eaf7 :: IO (FunPtr (A -> + FunPtr (CInt -> CDouble -> IO CChar) -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_args4_ptr@ +-} +hs_bindgen_51a7f0cfbd57eaf7 = fromBaseForeignType hs_bindgen_51a7f0cfbd57eaf7_base {-# NOINLINE funptr_args4_ptr #-} {-| __C declaration:__ @funptr_args4@ @@ -7777,13 +10839,20 @@ funptr_args4_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} funptr_args4_ptr = unsafePerformIO hs_bindgen_51a7f0cfbd57eaf7 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4a86c3a3b98a00d9" hs_bindgen_4a86c3a3b98a00d9_base :: BaseForeignType (IO (FunPtr (A -> + FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)) -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_args5_ptr@ -} -foreign import ccall safe "hs_bindgen_4a86c3a3b98a00d9" hs_bindgen_4a86c3a3b98a00d9 :: IO (FunPtr (A -> - FunPtr (CInt -> - CDouble -> - IO (Ptr CInt)) -> - IO Unit)) +hs_bindgen_4a86c3a3b98a00d9 :: IO (FunPtr (A -> + FunPtr (CInt -> CDouble -> IO (Ptr CInt)) -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_args5_ptr@ +-} +hs_bindgen_4a86c3a3b98a00d9 = fromBaseForeignType hs_bindgen_4a86c3a3b98a00d9_base {-# NOINLINE funptr_args5_ptr #-} {-| __C declaration:__ @funptr_args5@ @@ -7800,10 +10869,16 @@ funptr_args5_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} funptr_args5_ptr = unsafePerformIO hs_bindgen_4a86c3a3b98a00d9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1b13b480c009cf44" hs_bindgen_1b13b480c009cf44_base :: BaseForeignType (IO (FunPtr (A -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_comments1_ptr@ -} -foreign import ccall safe "hs_bindgen_1b13b480c009cf44" hs_bindgen_1b13b480c009cf44 :: IO (FunPtr (A -> - IO Unit)) +hs_bindgen_1b13b480c009cf44 :: IO (FunPtr (A -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_comments1_ptr@ +-} +hs_bindgen_1b13b480c009cf44 = fromBaseForeignType hs_bindgen_1b13b480c009cf44_base {-# NOINLINE comments1_ptr #-} {-| Comments in awkward places @@ -7827,11 +10902,17 @@ __defined at:__ @macros\/reparse.h:144:25@ __exported by:__ @macros\/reparse.h@ -} comments1_ptr = unsafePerformIO hs_bindgen_1b13b480c009cf44 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_410cb526b4cee637" hs_bindgen_410cb526b4cee637_base :: BaseForeignType (IO (FunPtr (A -> + CChar -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_prim_before1_ptr@ -} -foreign import ccall safe "hs_bindgen_410cb526b4cee637" hs_bindgen_410cb526b4cee637 :: IO (FunPtr (A -> - CChar -> - IO Unit)) +hs_bindgen_410cb526b4cee637 :: IO (FunPtr (A -> CChar -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_prim_before1_ptr@ +-} +hs_bindgen_410cb526b4cee637 = fromBaseForeignType hs_bindgen_410cb526b4cee637_base {-# NOINLINE const_prim_before1_ptr #-} {-| `const` qualifier @@ -7855,11 +10936,17 @@ __defined at:__ @macros\/reparse.h:179:6@ __exported by:__ @macros\/reparse.h@ -} const_prim_before1_ptr = unsafePerformIO hs_bindgen_410cb526b4cee637 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3b1e7a350d422127" hs_bindgen_3b1e7a350d422127_base :: BaseForeignType (IO (FunPtr (A -> + CSChar -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_prim_before2_ptr@ -} -foreign import ccall safe "hs_bindgen_3b1e7a350d422127" hs_bindgen_3b1e7a350d422127 :: IO (FunPtr (A -> - CSChar -> - IO Unit)) +hs_bindgen_3b1e7a350d422127 :: IO (FunPtr (A -> CSChar -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_prim_before2_ptr@ +-} +hs_bindgen_3b1e7a350d422127 = fromBaseForeignType hs_bindgen_3b1e7a350d422127_base {-# NOINLINE const_prim_before2_ptr #-} {-| __C declaration:__ @const_prim_before2@ @@ -7875,11 +10962,17 @@ const_prim_before2_ptr :: FunPtr (A -> CSChar -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_prim_before2_ptr = unsafePerformIO hs_bindgen_3b1e7a350d422127 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8aab98c0f956e496" hs_bindgen_8aab98c0f956e496_base :: BaseForeignType (IO (FunPtr (A -> + CUChar -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_prim_before3_ptr@ -} -foreign import ccall safe "hs_bindgen_8aab98c0f956e496" hs_bindgen_8aab98c0f956e496 :: IO (FunPtr (A -> - CUChar -> - IO Unit)) +hs_bindgen_8aab98c0f956e496 :: IO (FunPtr (A -> CUChar -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_prim_before3_ptr@ +-} +hs_bindgen_8aab98c0f956e496 = fromBaseForeignType hs_bindgen_8aab98c0f956e496_base {-# NOINLINE const_prim_before3_ptr #-} {-| __C declaration:__ @const_prim_before3@ @@ -7895,11 +10988,17 @@ const_prim_before3_ptr :: FunPtr (A -> CUChar -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_prim_before3_ptr = unsafePerformIO hs_bindgen_8aab98c0f956e496 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aeee0dd2b067cf07" hs_bindgen_aeee0dd2b067cf07_base :: BaseForeignType (IO (FunPtr (A -> + CChar -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_prim_after1_ptr@ -} -foreign import ccall safe "hs_bindgen_aeee0dd2b067cf07" hs_bindgen_aeee0dd2b067cf07 :: IO (FunPtr (A -> - CChar -> - IO Unit)) +hs_bindgen_aeee0dd2b067cf07 :: IO (FunPtr (A -> CChar -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_prim_after1_ptr@ +-} +hs_bindgen_aeee0dd2b067cf07 = fromBaseForeignType hs_bindgen_aeee0dd2b067cf07_base {-# NOINLINE const_prim_after1_ptr #-} {-| __C declaration:__ @const_prim_after1@ @@ -7915,11 +11014,17 @@ const_prim_after1_ptr :: FunPtr (A -> CChar -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_prim_after1_ptr = unsafePerformIO hs_bindgen_aeee0dd2b067cf07 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ca5ab7dc437ce5d1" hs_bindgen_ca5ab7dc437ce5d1_base :: BaseForeignType (IO (FunPtr (A -> + CSChar -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_prim_after2_ptr@ -} -foreign import ccall safe "hs_bindgen_ca5ab7dc437ce5d1" hs_bindgen_ca5ab7dc437ce5d1 :: IO (FunPtr (A -> - CSChar -> - IO Unit)) +hs_bindgen_ca5ab7dc437ce5d1 :: IO (FunPtr (A -> CSChar -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_prim_after2_ptr@ +-} +hs_bindgen_ca5ab7dc437ce5d1 = fromBaseForeignType hs_bindgen_ca5ab7dc437ce5d1_base {-# NOINLINE const_prim_after2_ptr #-} {-| __C declaration:__ @const_prim_after2@ @@ -7935,11 +11040,17 @@ const_prim_after2_ptr :: FunPtr (A -> CSChar -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_prim_after2_ptr = unsafePerformIO hs_bindgen_ca5ab7dc437ce5d1 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a6ae03f6051fcb2a" hs_bindgen_a6ae03f6051fcb2a_base :: BaseForeignType (IO (FunPtr (A -> + CUChar -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_prim_after3_ptr@ -} -foreign import ccall safe "hs_bindgen_a6ae03f6051fcb2a" hs_bindgen_a6ae03f6051fcb2a :: IO (FunPtr (A -> - CUChar -> - IO Unit)) +hs_bindgen_a6ae03f6051fcb2a :: IO (FunPtr (A -> CUChar -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_prim_after3_ptr@ +-} +hs_bindgen_a6ae03f6051fcb2a = fromBaseForeignType hs_bindgen_a6ae03f6051fcb2a_base {-# NOINLINE const_prim_after3_ptr #-} {-| __C declaration:__ @const_prim_after3@ @@ -7955,11 +11066,17 @@ const_prim_after3_ptr :: FunPtr (A -> CUChar -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_prim_after3_ptr = unsafePerformIO hs_bindgen_a6ae03f6051fcb2a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aea82678489f8007" hs_bindgen_aea82678489f8007_base :: BaseForeignType (IO (FunPtr (A -> + CFloat -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before1_ptr@ +-} +hs_bindgen_aea82678489f8007 :: IO (FunPtr (A -> CFloat -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before1_ptr@ -} -foreign import ccall safe "hs_bindgen_aea82678489f8007" hs_bindgen_aea82678489f8007 :: IO (FunPtr (A -> - CFloat -> - IO Unit)) +hs_bindgen_aea82678489f8007 = fromBaseForeignType hs_bindgen_aea82678489f8007_base {-# NOINLINE const_withoutSign_before1_ptr #-} {-| __C declaration:__ @const_withoutSign_before1@ @@ -7975,11 +11092,18 @@ const_withoutSign_before1_ptr :: FunPtr (A -> CFloat -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before1_ptr = unsafePerformIO hs_bindgen_aea82678489f8007 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_79b5f5987a75db98" hs_bindgen_79b5f5987a75db98_base :: BaseForeignType (IO (FunPtr (A -> + CDouble -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before2_ptr@ +-} +hs_bindgen_79b5f5987a75db98 :: IO (FunPtr (A -> + CDouble -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before2_ptr@ -} -foreign import ccall safe "hs_bindgen_79b5f5987a75db98" hs_bindgen_79b5f5987a75db98 :: IO (FunPtr (A -> - CDouble -> - IO Unit)) +hs_bindgen_79b5f5987a75db98 = fromBaseForeignType hs_bindgen_79b5f5987a75db98_base {-# NOINLINE const_withoutSign_before2_ptr #-} {-| __C declaration:__ @const_withoutSign_before2@ @@ -7995,11 +11119,17 @@ const_withoutSign_before2_ptr :: FunPtr (A -> CDouble -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before2_ptr = unsafePerformIO hs_bindgen_79b5f5987a75db98 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_fafbaf6c727e6e6d" hs_bindgen_fafbaf6c727e6e6d_base :: BaseForeignType (IO (FunPtr (A -> + CBool -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before3_ptr@ +-} +hs_bindgen_fafbaf6c727e6e6d :: IO (FunPtr (A -> CBool -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before3_ptr@ -} -foreign import ccall safe "hs_bindgen_fafbaf6c727e6e6d" hs_bindgen_fafbaf6c727e6e6d :: IO (FunPtr (A -> - CBool -> - IO Unit)) +hs_bindgen_fafbaf6c727e6e6d = fromBaseForeignType hs_bindgen_fafbaf6c727e6e6d_base {-# NOINLINE const_withoutSign_before3_ptr #-} {-| __C declaration:__ @const_withoutSign_before3@ @@ -8015,11 +11145,18 @@ const_withoutSign_before3_ptr :: FunPtr (A -> CBool -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before3_ptr = unsafePerformIO hs_bindgen_fafbaf6c727e6e6d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c9342430ac667d8a" hs_bindgen_c9342430ac667d8a_base :: BaseForeignType (IO (FunPtr (A -> + Some_struct -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before4_ptr@ -} -foreign import ccall safe "hs_bindgen_c9342430ac667d8a" hs_bindgen_c9342430ac667d8a :: IO (FunPtr (A -> - Some_struct -> - IO Unit)) +hs_bindgen_c9342430ac667d8a :: IO (FunPtr (A -> + Some_struct -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before4_ptr@ +-} +hs_bindgen_c9342430ac667d8a = fromBaseForeignType hs_bindgen_c9342430ac667d8a_base {-# NOINLINE const_withoutSign_before4_ptr #-} {-| __C declaration:__ @const_withoutSign_before4@ @@ -8036,11 +11173,18 @@ const_withoutSign_before4_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before4_ptr = unsafePerformIO hs_bindgen_c9342430ac667d8a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_25501097b98452bd" hs_bindgen_25501097b98452bd_base :: BaseForeignType (IO (FunPtr (A -> + Some_union -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before5_ptr@ +-} +hs_bindgen_25501097b98452bd :: IO (FunPtr (A -> + Some_union -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before5_ptr@ -} -foreign import ccall safe "hs_bindgen_25501097b98452bd" hs_bindgen_25501097b98452bd :: IO (FunPtr (A -> - Some_union -> - IO Unit)) +hs_bindgen_25501097b98452bd = fromBaseForeignType hs_bindgen_25501097b98452bd_base {-# NOINLINE const_withoutSign_before5_ptr #-} {-| __C declaration:__ @const_withoutSign_before5@ @@ -8057,11 +11201,18 @@ const_withoutSign_before5_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before5_ptr = unsafePerformIO hs_bindgen_25501097b98452bd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4b356af92ea4b405" hs_bindgen_4b356af92ea4b405_base :: BaseForeignType (IO (FunPtr (A -> + Some_enum -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before6_ptr@ +-} +hs_bindgen_4b356af92ea4b405 :: IO (FunPtr (A -> + Some_enum -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before6_ptr@ -} -foreign import ccall safe "hs_bindgen_4b356af92ea4b405" hs_bindgen_4b356af92ea4b405 :: IO (FunPtr (A -> - Some_enum -> - IO Unit)) +hs_bindgen_4b356af92ea4b405 = fromBaseForeignType hs_bindgen_4b356af92ea4b405_base {-# NOINLINE const_withoutSign_before6_ptr #-} {-| __C declaration:__ @const_withoutSign_before6@ @@ -8077,11 +11228,17 @@ const_withoutSign_before6_ptr :: FunPtr (A -> Some_enum -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before6_ptr = unsafePerformIO hs_bindgen_4b356af92ea4b405 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_90b574ff639ebbd5" hs_bindgen_90b574ff639ebbd5_base :: BaseForeignType (IO (FunPtr (A -> + CBool -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before7_ptr@ +-} +hs_bindgen_90b574ff639ebbd5 :: IO (FunPtr (A -> CBool -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before7_ptr@ -} -foreign import ccall safe "hs_bindgen_90b574ff639ebbd5" hs_bindgen_90b574ff639ebbd5 :: IO (FunPtr (A -> - CBool -> - IO Unit)) +hs_bindgen_90b574ff639ebbd5 = fromBaseForeignType hs_bindgen_90b574ff639ebbd5_base {-# NOINLINE const_withoutSign_before7_ptr #-} {-| __C declaration:__ @const_withoutSign_before7@ @@ -8097,11 +11254,18 @@ const_withoutSign_before7_ptr :: FunPtr (A -> CBool -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before7_ptr = unsafePerformIO hs_bindgen_90b574ff639ebbd5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cbb78eb3b806c344" hs_bindgen_cbb78eb3b806c344_base :: BaseForeignType (IO (FunPtr (A -> + HsBindgen.Runtime.Prelude.CSize -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before8_ptr@ -} -foreign import ccall safe "hs_bindgen_cbb78eb3b806c344" hs_bindgen_cbb78eb3b806c344 :: IO (FunPtr (A -> - HsBindgen.Runtime.Prelude.CSize -> - IO Unit)) +hs_bindgen_cbb78eb3b806c344 :: IO (FunPtr (A -> + HsBindgen.Runtime.Prelude.CSize -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_before8_ptr@ +-} +hs_bindgen_cbb78eb3b806c344 = fromBaseForeignType hs_bindgen_cbb78eb3b806c344_base {-# NOINLINE const_withoutSign_before8_ptr #-} {-| __C declaration:__ @const_withoutSign_before8@ @@ -8118,11 +11282,17 @@ const_withoutSign_before8_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} const_withoutSign_before8_ptr = unsafePerformIO hs_bindgen_cbb78eb3b806c344 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f4083b3232462a5b" hs_bindgen_f4083b3232462a5b_base :: BaseForeignType (IO (FunPtr (A -> + CFloat -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after1_ptr@ +-} +hs_bindgen_f4083b3232462a5b :: IO (FunPtr (A -> CFloat -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after1_ptr@ -} -foreign import ccall safe "hs_bindgen_f4083b3232462a5b" hs_bindgen_f4083b3232462a5b :: IO (FunPtr (A -> - CFloat -> - IO Unit)) +hs_bindgen_f4083b3232462a5b = fromBaseForeignType hs_bindgen_f4083b3232462a5b_base {-# NOINLINE const_withoutSign_after1_ptr #-} {-| __C declaration:__ @const_withoutSign_after1@ @@ -8138,11 +11308,18 @@ const_withoutSign_after1_ptr :: FunPtr (A -> CFloat -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after1_ptr = unsafePerformIO hs_bindgen_f4083b3232462a5b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cf16d660d9d916df" hs_bindgen_cf16d660d9d916df_base :: BaseForeignType (IO (FunPtr (A -> + CDouble -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after2_ptr@ +-} +hs_bindgen_cf16d660d9d916df :: IO (FunPtr (A -> + CDouble -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after2_ptr@ -} -foreign import ccall safe "hs_bindgen_cf16d660d9d916df" hs_bindgen_cf16d660d9d916df :: IO (FunPtr (A -> - CDouble -> - IO Unit)) +hs_bindgen_cf16d660d9d916df = fromBaseForeignType hs_bindgen_cf16d660d9d916df_base {-# NOINLINE const_withoutSign_after2_ptr #-} {-| __C declaration:__ @const_withoutSign_after2@ @@ -8158,11 +11335,17 @@ const_withoutSign_after2_ptr :: FunPtr (A -> CDouble -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after2_ptr = unsafePerformIO hs_bindgen_cf16d660d9d916df +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_41a40ed22011f536" hs_bindgen_41a40ed22011f536_base :: BaseForeignType (IO (FunPtr (A -> + CBool -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after3_ptr@ +-} +hs_bindgen_41a40ed22011f536 :: IO (FunPtr (A -> CBool -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after3_ptr@ -} -foreign import ccall safe "hs_bindgen_41a40ed22011f536" hs_bindgen_41a40ed22011f536 :: IO (FunPtr (A -> - CBool -> - IO Unit)) +hs_bindgen_41a40ed22011f536 = fromBaseForeignType hs_bindgen_41a40ed22011f536_base {-# NOINLINE const_withoutSign_after3_ptr #-} {-| __C declaration:__ @const_withoutSign_after3@ @@ -8178,11 +11361,18 @@ const_withoutSign_after3_ptr :: FunPtr (A -> CBool -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after3_ptr = unsafePerformIO hs_bindgen_41a40ed22011f536 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4bc0069f381d29c9" hs_bindgen_4bc0069f381d29c9_base :: BaseForeignType (IO (FunPtr (A -> + Some_struct -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after4_ptr@ -} -foreign import ccall safe "hs_bindgen_4bc0069f381d29c9" hs_bindgen_4bc0069f381d29c9 :: IO (FunPtr (A -> - Some_struct -> - IO Unit)) +hs_bindgen_4bc0069f381d29c9 :: IO (FunPtr (A -> + Some_struct -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after4_ptr@ +-} +hs_bindgen_4bc0069f381d29c9 = fromBaseForeignType hs_bindgen_4bc0069f381d29c9_base {-# NOINLINE const_withoutSign_after4_ptr #-} {-| __C declaration:__ @const_withoutSign_after4@ @@ -8199,11 +11389,18 @@ const_withoutSign_after4_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after4_ptr = unsafePerformIO hs_bindgen_4bc0069f381d29c9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e064a509e456b021" hs_bindgen_e064a509e456b021_base :: BaseForeignType (IO (FunPtr (A -> + Some_union -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after5_ptr@ +-} +hs_bindgen_e064a509e456b021 :: IO (FunPtr (A -> + Some_union -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after5_ptr@ -} -foreign import ccall safe "hs_bindgen_e064a509e456b021" hs_bindgen_e064a509e456b021 :: IO (FunPtr (A -> - Some_union -> - IO Unit)) +hs_bindgen_e064a509e456b021 = fromBaseForeignType hs_bindgen_e064a509e456b021_base {-# NOINLINE const_withoutSign_after5_ptr #-} {-| __C declaration:__ @const_withoutSign_after5@ @@ -8219,11 +11416,18 @@ const_withoutSign_after5_ptr :: FunPtr (A -> Some_union -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after5_ptr = unsafePerformIO hs_bindgen_e064a509e456b021 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b89597d47b21f2fd" hs_bindgen_b89597d47b21f2fd_base :: BaseForeignType (IO (FunPtr (A -> + Some_enum -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after6_ptr@ +-} +hs_bindgen_b89597d47b21f2fd :: IO (FunPtr (A -> + Some_enum -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after6_ptr@ -} -foreign import ccall safe "hs_bindgen_b89597d47b21f2fd" hs_bindgen_b89597d47b21f2fd :: IO (FunPtr (A -> - Some_enum -> - IO Unit)) +hs_bindgen_b89597d47b21f2fd = fromBaseForeignType hs_bindgen_b89597d47b21f2fd_base {-# NOINLINE const_withoutSign_after6_ptr #-} {-| __C declaration:__ @const_withoutSign_after6@ @@ -8239,11 +11443,17 @@ const_withoutSign_after6_ptr :: FunPtr (A -> Some_enum -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after6_ptr = unsafePerformIO hs_bindgen_b89597d47b21f2fd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_127b2fb737af1d7a" hs_bindgen_127b2fb737af1d7a_base :: BaseForeignType (IO (FunPtr (A -> + CBool -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after7_ptr@ +-} +hs_bindgen_127b2fb737af1d7a :: IO (FunPtr (A -> CBool -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after7_ptr@ -} -foreign import ccall safe "hs_bindgen_127b2fb737af1d7a" hs_bindgen_127b2fb737af1d7a :: IO (FunPtr (A -> - CBool -> - IO Unit)) +hs_bindgen_127b2fb737af1d7a = fromBaseForeignType hs_bindgen_127b2fb737af1d7a_base {-# NOINLINE const_withoutSign_after7_ptr #-} {-| __C declaration:__ @const_withoutSign_after7@ @@ -8259,11 +11469,18 @@ const_withoutSign_after7_ptr :: FunPtr (A -> CBool -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after7_ptr = unsafePerformIO hs_bindgen_127b2fb737af1d7a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_05c7bd4fa507a58c" hs_bindgen_05c7bd4fa507a58c_base :: BaseForeignType (IO (FunPtr (A -> + HsBindgen.Runtime.Prelude.CSize -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after8_ptr@ -} -foreign import ccall safe "hs_bindgen_05c7bd4fa507a58c" hs_bindgen_05c7bd4fa507a58c :: IO (FunPtr (A -> - HsBindgen.Runtime.Prelude.CSize -> - IO Unit)) +hs_bindgen_05c7bd4fa507a58c :: IO (FunPtr (A -> + HsBindgen.Runtime.Prelude.CSize -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_withoutSign_after8_ptr@ +-} +hs_bindgen_05c7bd4fa507a58c = fromBaseForeignType hs_bindgen_05c7bd4fa507a58c_base {-# NOINLINE const_withoutSign_after8_ptr #-} {-| __C declaration:__ @const_withoutSign_after8@ @@ -8280,11 +11497,18 @@ const_withoutSign_after8_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} const_withoutSign_after8_ptr = unsafePerformIO hs_bindgen_05c7bd4fa507a58c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_dfa6f2ec505f391a" hs_bindgen_dfa6f2ec505f391a_base :: BaseForeignType (IO (FunPtr (A -> + Ptr CInt -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args1_ptr@ +-} +hs_bindgen_dfa6f2ec505f391a :: IO (FunPtr (A -> + Ptr CInt -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args1_ptr@ -} -foreign import ccall safe "hs_bindgen_dfa6f2ec505f391a" hs_bindgen_dfa6f2ec505f391a :: IO (FunPtr (A -> - Ptr CInt -> - IO Unit)) +hs_bindgen_dfa6f2ec505f391a = fromBaseForeignType hs_bindgen_dfa6f2ec505f391a_base {-# NOINLINE const_pointers_args1_ptr #-} {-| __C declaration:__ @const_pointers_args1@ @@ -8300,11 +11524,18 @@ const_pointers_args1_ptr :: FunPtr (A -> Ptr CInt -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_pointers_args1_ptr = unsafePerformIO hs_bindgen_dfa6f2ec505f391a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2f758756849ca2b5" hs_bindgen_2f758756849ca2b5_base :: BaseForeignType (IO (FunPtr (A -> + Ptr CInt -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args2_ptr@ +-} +hs_bindgen_2f758756849ca2b5 :: IO (FunPtr (A -> + Ptr CInt -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args2_ptr@ -} -foreign import ccall safe "hs_bindgen_2f758756849ca2b5" hs_bindgen_2f758756849ca2b5 :: IO (FunPtr (A -> - Ptr CInt -> - IO Unit)) +hs_bindgen_2f758756849ca2b5 = fromBaseForeignType hs_bindgen_2f758756849ca2b5_base {-# NOINLINE const_pointers_args2_ptr #-} {-| __C declaration:__ @const_pointers_args2@ @@ -8320,11 +11551,18 @@ const_pointers_args2_ptr :: FunPtr (A -> Ptr CInt -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_pointers_args2_ptr = unsafePerformIO hs_bindgen_2f758756849ca2b5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1f9d3190b4433852" hs_bindgen_1f9d3190b4433852_base :: BaseForeignType (IO (FunPtr (A -> + Ptr CInt -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args3_ptr@ +-} +hs_bindgen_1f9d3190b4433852 :: IO (FunPtr (A -> + Ptr CInt -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args3_ptr@ -} -foreign import ccall safe "hs_bindgen_1f9d3190b4433852" hs_bindgen_1f9d3190b4433852 :: IO (FunPtr (A -> - Ptr CInt -> - IO Unit)) +hs_bindgen_1f9d3190b4433852 = fromBaseForeignType hs_bindgen_1f9d3190b4433852_base {-# NOINLINE const_pointers_args3_ptr #-} {-| __C declaration:__ @const_pointers_args3@ @@ -8340,11 +11578,18 @@ const_pointers_args3_ptr :: FunPtr (A -> Ptr CInt -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_pointers_args3_ptr = unsafePerformIO hs_bindgen_1f9d3190b4433852 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1579ab85f0fa217b" hs_bindgen_1579ab85f0fa217b_base :: BaseForeignType (IO (FunPtr (A -> + Ptr CInt -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args4_ptr@ -} -foreign import ccall safe "hs_bindgen_1579ab85f0fa217b" hs_bindgen_1579ab85f0fa217b :: IO (FunPtr (A -> - Ptr CInt -> - IO Unit)) +hs_bindgen_1579ab85f0fa217b :: IO (FunPtr (A -> + Ptr CInt -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args4_ptr@ +-} +hs_bindgen_1579ab85f0fa217b = fromBaseForeignType hs_bindgen_1579ab85f0fa217b_base {-# NOINLINE const_pointers_args4_ptr #-} {-| __C declaration:__ @const_pointers_args4@ @@ -8360,11 +11605,18 @@ const_pointers_args4_ptr :: FunPtr (A -> Ptr CInt -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_pointers_args4_ptr = unsafePerformIO hs_bindgen_1579ab85f0fa217b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b4770dc5310bc558" hs_bindgen_b4770dc5310bc558_base :: BaseForeignType (IO (FunPtr (A -> + Ptr CInt -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args5_ptr@ +-} +hs_bindgen_b4770dc5310bc558 :: IO (FunPtr (A -> + Ptr CInt -> IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_args5_ptr@ -} -foreign import ccall safe "hs_bindgen_b4770dc5310bc558" hs_bindgen_b4770dc5310bc558 :: IO (FunPtr (A -> - Ptr CInt -> - IO Unit)) +hs_bindgen_b4770dc5310bc558 = fromBaseForeignType hs_bindgen_b4770dc5310bc558_base {-# NOINLINE const_pointers_args5_ptr #-} {-| __C declaration:__ @const_pointers_args5@ @@ -8380,10 +11632,16 @@ const_pointers_args5_ptr :: FunPtr (A -> Ptr CInt -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_pointers_args5_ptr = unsafePerformIO hs_bindgen_b4770dc5310bc558 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8422fbf55ee37cbb" hs_bindgen_8422fbf55ee37cbb_base :: BaseForeignType (IO (FunPtr (A -> + IO (Ptr CInt)))) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret1_ptr@ +-} +hs_bindgen_8422fbf55ee37cbb :: IO (FunPtr (A -> IO (Ptr CInt))) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret1_ptr@ -} -foreign import ccall safe "hs_bindgen_8422fbf55ee37cbb" hs_bindgen_8422fbf55ee37cbb :: IO (FunPtr (A -> - IO (Ptr CInt))) +hs_bindgen_8422fbf55ee37cbb = fromBaseForeignType hs_bindgen_8422fbf55ee37cbb_base {-# NOINLINE const_pointers_ret1_ptr #-} {-| __C declaration:__ @const_pointers_ret1@ @@ -8399,10 +11657,16 @@ const_pointers_ret1_ptr :: FunPtr (A -> IO (Ptr CInt)) __exported by:__ @macros\/reparse.h@ -} const_pointers_ret1_ptr = unsafePerformIO hs_bindgen_8422fbf55ee37cbb +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7d62d267cb012ebf" hs_bindgen_7d62d267cb012ebf_base :: BaseForeignType (IO (FunPtr (A -> + IO (Ptr CInt)))) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret2_ptr@ +-} +hs_bindgen_7d62d267cb012ebf :: IO (FunPtr (A -> IO (Ptr CInt))) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret2_ptr@ -} -foreign import ccall safe "hs_bindgen_7d62d267cb012ebf" hs_bindgen_7d62d267cb012ebf :: IO (FunPtr (A -> - IO (Ptr CInt))) +hs_bindgen_7d62d267cb012ebf = fromBaseForeignType hs_bindgen_7d62d267cb012ebf_base {-# NOINLINE const_pointers_ret2_ptr #-} {-| __C declaration:__ @const_pointers_ret2@ @@ -8418,10 +11682,16 @@ const_pointers_ret2_ptr :: FunPtr (A -> IO (Ptr CInt)) __exported by:__ @macros\/reparse.h@ -} const_pointers_ret2_ptr = unsafePerformIO hs_bindgen_7d62d267cb012ebf +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d56e13b56b7e1cf7" hs_bindgen_d56e13b56b7e1cf7_base :: BaseForeignType (IO (FunPtr (A -> + IO (Ptr CInt)))) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret3_ptr@ -} -foreign import ccall safe "hs_bindgen_d56e13b56b7e1cf7" hs_bindgen_d56e13b56b7e1cf7 :: IO (FunPtr (A -> - IO (Ptr CInt))) +hs_bindgen_d56e13b56b7e1cf7 :: IO (FunPtr (A -> IO (Ptr CInt))) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret3_ptr@ +-} +hs_bindgen_d56e13b56b7e1cf7 = fromBaseForeignType hs_bindgen_d56e13b56b7e1cf7_base {-# NOINLINE const_pointers_ret3_ptr #-} {-| __C declaration:__ @const_pointers_ret3@ @@ -8437,10 +11707,16 @@ const_pointers_ret3_ptr :: FunPtr (A -> IO (Ptr CInt)) __exported by:__ @macros\/reparse.h@ -} const_pointers_ret3_ptr = unsafePerformIO hs_bindgen_d56e13b56b7e1cf7 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bedc6b38f49c61ea" hs_bindgen_bedc6b38f49c61ea_base :: BaseForeignType (IO (FunPtr (A -> + IO (Ptr CInt)))) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret4_ptr@ +-} +hs_bindgen_bedc6b38f49c61ea :: IO (FunPtr (A -> IO (Ptr CInt))) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret4_ptr@ -} -foreign import ccall safe "hs_bindgen_bedc6b38f49c61ea" hs_bindgen_bedc6b38f49c61ea :: IO (FunPtr (A -> - IO (Ptr CInt))) +hs_bindgen_bedc6b38f49c61ea = fromBaseForeignType hs_bindgen_bedc6b38f49c61ea_base {-# NOINLINE const_pointers_ret4_ptr #-} {-| __C declaration:__ @const_pointers_ret4@ @@ -8456,10 +11732,16 @@ const_pointers_ret4_ptr :: FunPtr (A -> IO (Ptr CInt)) __exported by:__ @macros\/reparse.h@ -} const_pointers_ret4_ptr = unsafePerformIO hs_bindgen_bedc6b38f49c61ea +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8d027f9f58006eb9" hs_bindgen_8d027f9f58006eb9_base :: BaseForeignType (IO (FunPtr (A -> + IO (Ptr CInt)))) +{-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret5_ptr@ +-} +hs_bindgen_8d027f9f58006eb9 :: IO (FunPtr (A -> IO (Ptr CInt))) {-| __unique:__ @test_macrosreparse_Example_get_const_pointers_ret5_ptr@ -} -foreign import ccall safe "hs_bindgen_8d027f9f58006eb9" hs_bindgen_8d027f9f58006eb9 :: IO (FunPtr (A -> - IO (Ptr CInt))) +hs_bindgen_8d027f9f58006eb9 = fromBaseForeignType hs_bindgen_8d027f9f58006eb9_base {-# NOINLINE const_pointers_ret5_ptr #-} {-| __C declaration:__ @const_pointers_ret5@ @@ -8475,10 +11757,17 @@ const_pointers_ret5_ptr :: FunPtr (A -> IO (Ptr CInt)) __exported by:__ @macros\/reparse.h@ -} const_pointers_ret5_ptr = unsafePerformIO hs_bindgen_8d027f9f58006eb9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_882567df89856ac9" hs_bindgen_882567df89856ac9_base :: BaseForeignType (IO (FunPtr (IncompleteArray A -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_array_elem1_ptr@ +-} +hs_bindgen_882567df89856ac9 :: IO (FunPtr (IncompleteArray A -> + IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_array_elem1_ptr@ -} -foreign import ccall safe "hs_bindgen_882567df89856ac9" hs_bindgen_882567df89856ac9 :: IO (FunPtr (IncompleteArray A -> - IO Unit)) +hs_bindgen_882567df89856ac9 = fromBaseForeignType hs_bindgen_882567df89856ac9_base {-# NOINLINE const_array_elem1_ptr #-} {-| __C declaration:__ @const_array_elem1@ @@ -8494,10 +11783,17 @@ const_array_elem1_ptr :: FunPtr (IncompleteArray A -> IO Unit) __exported by:__ @macros\/reparse.h@ -} const_array_elem1_ptr = unsafePerformIO hs_bindgen_882567df89856ac9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_70e4ab7a50eb5360" hs_bindgen_70e4ab7a50eb5360_base :: BaseForeignType (IO (FunPtr (IncompleteArray (Ptr A) -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_const_array_elem2_ptr@ -} -foreign import ccall safe "hs_bindgen_70e4ab7a50eb5360" hs_bindgen_70e4ab7a50eb5360 :: IO (FunPtr (IncompleteArray (Ptr A) -> - IO Unit)) +hs_bindgen_70e4ab7a50eb5360 :: IO (FunPtr (IncompleteArray (Ptr A) -> + IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_const_array_elem2_ptr@ +-} +hs_bindgen_70e4ab7a50eb5360 = fromBaseForeignType hs_bindgen_70e4ab7a50eb5360_base {-# NOINLINE const_array_elem2_ptr #-} {-| __C declaration:__ @const_array_elem2@ @@ -8514,10 +11810,17 @@ const_array_elem2_ptr :: FunPtr (IncompleteArray (Ptr A) -> __exported by:__ @macros\/reparse.h@ -} const_array_elem2_ptr = unsafePerformIO hs_bindgen_70e4ab7a50eb5360 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_14a733fd770b7242" hs_bindgen_14a733fd770b7242_base :: BaseForeignType (IO (FunPtr (IncompleteArray (Ptr A) -> + IO Unit))) +{-| __unique:__ @test_macrosreparse_Example_get_const_array_elem3_ptr@ +-} +hs_bindgen_14a733fd770b7242 :: IO (FunPtr (IncompleteArray (Ptr A) -> + IO Unit)) {-| __unique:__ @test_macrosreparse_Example_get_const_array_elem3_ptr@ -} -foreign import ccall safe "hs_bindgen_14a733fd770b7242" hs_bindgen_14a733fd770b7242 :: IO (FunPtr (IncompleteArray (Ptr A) -> - IO Unit)) +hs_bindgen_14a733fd770b7242 = fromBaseForeignType hs_bindgen_14a733fd770b7242_base {-# NOINLINE const_array_elem3_ptr #-} {-| __C declaration:__ @const_array_elem3@ @@ -8534,9 +11837,15 @@ const_array_elem3_ptr :: FunPtr (IncompleteArray (Ptr A) -> __exported by:__ @macros\/reparse.h@ -} const_array_elem3_ptr = unsafePerformIO hs_bindgen_14a733fd770b7242 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8e462fca4a002e73" hs_bindgen_8e462fca4a002e73_base :: BaseForeignType (IO (FunPtr (IO A))) +{-| __unique:__ @test_macrosreparse_Example_get_noParams1_ptr@ +-} +hs_bindgen_8e462fca4a002e73 :: IO (FunPtr (IO A)) {-| __unique:__ @test_macrosreparse_Example_get_noParams1_ptr@ -} -foreign import ccall safe "hs_bindgen_8e462fca4a002e73" hs_bindgen_8e462fca4a002e73 :: IO (FunPtr (IO A)) +hs_bindgen_8e462fca4a002e73 = fromBaseForeignType hs_bindgen_8e462fca4a002e73_base {-# NOINLINE noParams1_ptr #-} {-| Other examples we reparsed /incorrectly/ before language-c @@ -8556,9 +11865,15 @@ __defined at:__ @macros\/reparse.h:256:3@ __exported by:__ @macros\/reparse.h@ -} noParams1_ptr = unsafePerformIO hs_bindgen_8e462fca4a002e73 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_42667590c95d450e" hs_bindgen_42667590c95d450e_base :: BaseForeignType (IO (FunPtr (IO A))) +{-| __unique:__ @test_macrosreparse_Example_get_noParams2_ptr@ +-} +hs_bindgen_42667590c95d450e :: IO (FunPtr (IO A)) {-| __unique:__ @test_macrosreparse_Example_get_noParams2_ptr@ -} -foreign import ccall safe "hs_bindgen_42667590c95d450e" hs_bindgen_42667590c95d450e :: IO (FunPtr (IO A)) +hs_bindgen_42667590c95d450e = fromBaseForeignType hs_bindgen_42667590c95d450e_base {-# NOINLINE noParams2_ptr #-} {-| __C declaration:__ @noParams2@ @@ -8574,11 +11889,18 @@ noParams2_ptr :: FunPtr (IO A) __exported by:__ @macros\/reparse.h@ -} noParams2_ptr = unsafePerformIO hs_bindgen_42667590c95d450e +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_23777cd9313c8c63" hs_bindgen_23777cd9313c8c63_base :: BaseForeignType (IO (FunPtr (A -> + FunPtr (IO CInt) -> + IO Unit))) {-| __unique:__ @test_macrosreparse_Example_get_noParams3_ptr@ -} -foreign import ccall safe "hs_bindgen_23777cd9313c8c63" hs_bindgen_23777cd9313c8c63 :: IO (FunPtr (A -> - FunPtr (IO CInt) -> - IO Unit)) +hs_bindgen_23777cd9313c8c63 :: IO (FunPtr (A -> + FunPtr (IO CInt) -> IO Unit)) +{-| __unique:__ @test_macrosreparse_Example_get_noParams3_ptr@ +-} +hs_bindgen_23777cd9313c8c63 = fromBaseForeignType hs_bindgen_23777cd9313c8c63_base {-# NOINLINE noParams3_ptr #-} {-| __C declaration:__ @noParams3@ @@ -8594,10 +11916,17 @@ noParams3_ptr :: FunPtr (A -> FunPtr (IO CInt) -> IO Unit) __exported by:__ @macros\/reparse.h@ -} noParams3_ptr = unsafePerformIO hs_bindgen_23777cd9313c8c63 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a8f974caf74669f9" hs_bindgen_a8f974caf74669f9_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (IO Unit))))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret1_ptr@ +-} +hs_bindgen_a8f974caf74669f9 :: IO (FunPtr (A -> + IO (FunPtr (IO Unit)))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret1_ptr@ -} -foreign import ccall safe "hs_bindgen_a8f974caf74669f9" hs_bindgen_a8f974caf74669f9 :: IO (FunPtr (A -> - IO (FunPtr (IO Unit)))) +hs_bindgen_a8f974caf74669f9 = fromBaseForeignType hs_bindgen_a8f974caf74669f9_base {-# NOINLINE funptr_ret1_ptr #-} {-| __C declaration:__ @funptr_ret1@ @@ -8613,10 +11942,17 @@ funptr_ret1_ptr :: FunPtr (A -> IO (FunPtr (IO Unit))) __exported by:__ @macros\/reparse.h@ -} funptr_ret1_ptr = unsafePerformIO hs_bindgen_a8f974caf74669f9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f13795ebabb26526" hs_bindgen_f13795ebabb26526_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (IO CInt))))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret2_ptr@ +-} +hs_bindgen_f13795ebabb26526 :: IO (FunPtr (A -> + IO (FunPtr (IO CInt)))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret2_ptr@ -} -foreign import ccall safe "hs_bindgen_f13795ebabb26526" hs_bindgen_f13795ebabb26526 :: IO (FunPtr (A -> - IO (FunPtr (IO CInt)))) +hs_bindgen_f13795ebabb26526 = fromBaseForeignType hs_bindgen_f13795ebabb26526_base {-# NOINLINE funptr_ret2_ptr #-} {-| __C declaration:__ @funptr_ret2@ @@ -8632,11 +11968,18 @@ funptr_ret2_ptr :: FunPtr (A -> IO (FunPtr (IO CInt))) __exported by:__ @macros\/reparse.h@ -} funptr_ret2_ptr = unsafePerformIO hs_bindgen_f13795ebabb26526 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2515837794143ac1" hs_bindgen_2515837794143ac1_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (CInt -> + IO Unit))))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret3_ptr@ +-} +hs_bindgen_2515837794143ac1 :: IO (FunPtr (A -> + IO (FunPtr (CInt -> IO Unit)))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret3_ptr@ -} -foreign import ccall safe "hs_bindgen_2515837794143ac1" hs_bindgen_2515837794143ac1 :: IO (FunPtr (A -> - IO (FunPtr (CInt -> - IO Unit)))) +hs_bindgen_2515837794143ac1 = fromBaseForeignType hs_bindgen_2515837794143ac1_base {-# NOINLINE funptr_ret3_ptr #-} {-| __C declaration:__ @funptr_ret3@ @@ -8652,12 +11995,19 @@ funptr_ret3_ptr :: FunPtr (A -> IO (FunPtr (CInt -> IO Unit))) __exported by:__ @macros\/reparse.h@ -} funptr_ret3_ptr = unsafePerformIO hs_bindgen_2515837794143ac1 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f01ceaf447c3de04" hs_bindgen_f01ceaf447c3de04_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (CInt -> + CDouble -> + IO CChar))))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret4_ptr@ -} -foreign import ccall safe "hs_bindgen_f01ceaf447c3de04" hs_bindgen_f01ceaf447c3de04 :: IO (FunPtr (A -> - IO (FunPtr (CInt -> - CDouble -> - IO CChar)))) +hs_bindgen_f01ceaf447c3de04 :: IO (FunPtr (A -> + IO (FunPtr (CInt -> CDouble -> IO CChar)))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret4_ptr@ +-} +hs_bindgen_f01ceaf447c3de04 = fromBaseForeignType hs_bindgen_f01ceaf447c3de04_base {-# NOINLINE funptr_ret4_ptr #-} {-| __C declaration:__ @funptr_ret4@ @@ -8674,12 +12024,19 @@ funptr_ret4_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} funptr_ret4_ptr = unsafePerformIO hs_bindgen_f01ceaf447c3de04 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3cb2c77a66e6f46f" hs_bindgen_3cb2c77a66e6f46f_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret5_ptr@ +-} +hs_bindgen_3cb2c77a66e6f46f :: IO (FunPtr (A -> + IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret5_ptr@ -} -foreign import ccall safe "hs_bindgen_3cb2c77a66e6f46f" hs_bindgen_3cb2c77a66e6f46f :: IO (FunPtr (A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))))) +hs_bindgen_3cb2c77a66e6f46f = fromBaseForeignType hs_bindgen_3cb2c77a66e6f46f_base {-# NOINLINE funptr_ret5_ptr #-} {-| __C declaration:__ @funptr_ret5@ @@ -8696,12 +12053,19 @@ funptr_ret5_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} funptr_ret5_ptr = unsafePerformIO hs_bindgen_3cb2c77a66e6f46f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3a28c985fce638f9" hs_bindgen_3a28c985fce638f9_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret6_ptr@ +-} +hs_bindgen_3a28c985fce638f9 :: IO (FunPtr (A -> + IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret6_ptr@ -} -foreign import ccall safe "hs_bindgen_3a28c985fce638f9" hs_bindgen_3a28c985fce638f9 :: IO (FunPtr (A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))))) +hs_bindgen_3a28c985fce638f9 = fromBaseForeignType hs_bindgen_3a28c985fce638f9_base {-# NOINLINE funptr_ret6_ptr #-} {-| __C declaration:__ @funptr_ret6@ @@ -8718,12 +12082,19 @@ funptr_ret6_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} funptr_ret6_ptr = unsafePerformIO hs_bindgen_3a28c985fce638f9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e155fd240d710be2" hs_bindgen_e155fd240d710be2_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret7_ptr@ +-} +hs_bindgen_e155fd240d710be2 :: IO (FunPtr (A -> + IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret7_ptr@ -} -foreign import ccall safe "hs_bindgen_e155fd240d710be2" hs_bindgen_e155fd240d710be2 :: IO (FunPtr (A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))))) +hs_bindgen_e155fd240d710be2 = fromBaseForeignType hs_bindgen_e155fd240d710be2_base {-# NOINLINE funptr_ret7_ptr #-} {-| __C declaration:__ @funptr_ret7@ @@ -8740,12 +12111,19 @@ funptr_ret7_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} funptr_ret7_ptr = unsafePerformIO hs_bindgen_e155fd240d710be2 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_61261c2147d69f98" hs_bindgen_61261c2147d69f98_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret8_ptr@ -} -foreign import ccall safe "hs_bindgen_61261c2147d69f98" hs_bindgen_61261c2147d69f98 :: IO (FunPtr (A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))))) +hs_bindgen_61261c2147d69f98 :: IO (FunPtr (A -> + IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret8_ptr@ +-} +hs_bindgen_61261c2147d69f98 = fromBaseForeignType hs_bindgen_61261c2147d69f98_base {-# NOINLINE funptr_ret8_ptr #-} {-| __C declaration:__ @funptr_ret8@ @@ -8762,12 +12140,19 @@ funptr_ret8_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} funptr_ret8_ptr = unsafePerformIO hs_bindgen_61261c2147d69f98 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e3c71dfaf82486c8" hs_bindgen_e3c71dfaf82486c8_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret9_ptr@ +-} +hs_bindgen_e3c71dfaf82486c8 :: IO (FunPtr (A -> + IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret9_ptr@ -} -foreign import ccall safe "hs_bindgen_e3c71dfaf82486c8" hs_bindgen_e3c71dfaf82486c8 :: IO (FunPtr (A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))))) +hs_bindgen_e3c71dfaf82486c8 = fromBaseForeignType hs_bindgen_e3c71dfaf82486c8_base {-# NOINLINE funptr_ret9_ptr #-} {-| __C declaration:__ @funptr_ret9@ @@ -8784,12 +12169,19 @@ funptr_ret9_ptr :: FunPtr (A -> __exported by:__ @macros\/reparse.h@ -} funptr_ret9_ptr = unsafePerformIO hs_bindgen_e3c71dfaf82486c8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6a47446b9176f0bf" hs_bindgen_6a47446b9176f0bf_base :: BaseForeignType (IO (FunPtr (A -> + IO (FunPtr (CInt -> + CDouble -> + IO (Ptr CInt)))))) +{-| __unique:__ @test_macrosreparse_Example_get_funptr_ret10_ptr@ +-} +hs_bindgen_6a47446b9176f0bf :: IO (FunPtr (A -> + IO (FunPtr (CInt -> CDouble -> IO (Ptr CInt))))) {-| __unique:__ @test_macrosreparse_Example_get_funptr_ret10_ptr@ -} -foreign import ccall safe "hs_bindgen_6a47446b9176f0bf" hs_bindgen_6a47446b9176f0bf :: IO (FunPtr (A -> - IO (FunPtr (CInt -> - CDouble -> - IO (Ptr CInt))))) +hs_bindgen_6a47446b9176f0bf = fromBaseForeignType hs_bindgen_6a47446b9176f0bf_base {-# NOINLINE funptr_ret10_ptr #-} {-| __C declaration:__ @funptr_ret10@ diff --git a/hs-bindgen/fixtures/manual/arrays/Example/FunPtr.hs b/hs-bindgen/fixtures/manual/arrays/Example/FunPtr.hs index 7dbffae78..04f5db194 100644 --- a/hs-bindgen/fixtures/manual/arrays/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/manual/arrays/Example/FunPtr.hs @@ -7,6 +7,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -32,10 +33,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_24c867a3e91cab5d" hs_bindgen_24c867a3e91cab5d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Matrix -> Matrix -> IO ()))) + {-| __unique:__ @test_manualarrays_Example_get_transpose_ptr@ -} -foreign import ccall unsafe "hs_bindgen_24c867a3e91cab5d" hs_bindgen_24c867a3e91cab5d :: +hs_bindgen_24c867a3e91cab5d :: IO (Ptr.FunPtr (Matrix -> Matrix -> IO ())) +hs_bindgen_24c867a3e91cab5d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_24c867a3e91cab5d_base {-# NOINLINE transpose_ptr #-} @@ -49,10 +57,17 @@ transpose_ptr :: Ptr.FunPtr (Matrix -> Matrix -> IO ()) transpose_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_24c867a3e91cab5d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_66af82cae0c5134a" hs_bindgen_66af82cae0c5134a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Triplet_ptrs -> IO ()))) + {-| __unique:__ @test_manualarrays_Example_get_pretty_print_triplets_ptr@ -} -foreign import ccall unsafe "hs_bindgen_66af82cae0c5134a" hs_bindgen_66af82cae0c5134a :: +hs_bindgen_66af82cae0c5134a :: IO (Ptr.FunPtr (Triplet_ptrs -> IO ())) +hs_bindgen_66af82cae0c5134a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_66af82cae0c5134a_base {-# NOINLINE pretty_print_triplets_ptr #-} diff --git a/hs-bindgen/fixtures/manual/arrays/Example/Global.hs b/hs-bindgen/fixtures/manual/arrays/Example/Global.hs index 5ca7bfbf4..88f0fa94d 100644 --- a/hs-bindgen/fixtures/manual/arrays/Example/Global.hs +++ b/hs-bindgen/fixtures/manual/arrays/Example/Global.hs @@ -10,6 +10,7 @@ import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.IncompleteArray import qualified HsBindgen.Runtime.Prelude import Example @@ -55,10 +56,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_57b6693818620aec" hs_bindgen_57b6693818620aec_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 1) FC.CInt))) + {-| __unique:__ @test_manualarrays_Example_get_arr1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_57b6693818620aec" hs_bindgen_57b6693818620aec :: +hs_bindgen_57b6693818620aec :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 1) FC.CInt)) +hs_bindgen_57b6693818620aec = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_57b6693818620aec_base {-# NOINLINE arr1_ptr #-} @@ -74,10 +82,17 @@ arr1_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 1) FC.CInt) arr1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_57b6693818620aec +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_928e8bd0dc2d0be1" hs_bindgen_928e8bd0dc2d0be1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) + {-| __unique:__ @test_manualarrays_Example_get_arr2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_928e8bd0dc2d0be1" hs_bindgen_928e8bd0dc2d0be1 :: +hs_bindgen_928e8bd0dc2d0be1 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) +hs_bindgen_928e8bd0dc2d0be1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_928e8bd0dc2d0be1_base {-# NOINLINE arr2_ptr #-} @@ -93,10 +108,17 @@ arr2_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt) arr2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_928e8bd0dc2d0be1 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e6493a6ad08768b6" hs_bindgen_e6493a6ad08768b6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt))) + {-| __unique:__ @test_manualarrays_Example_get_arr3_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e6493a6ad08768b6" hs_bindgen_e6493a6ad08768b6 :: +hs_bindgen_e6493a6ad08768b6 :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt)) +hs_bindgen_e6493a6ad08768b6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e6493a6ad08768b6_base {-# NOINLINE arr3_ptr #-} @@ -112,10 +134,17 @@ arr3_ptr :: Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray FC.CInt) arr3_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e6493a6ad08768b6 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e692ad991693d041" hs_bindgen_e692ad991693d041_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) + {-| __unique:__ @test_manualarrays_Example_get_sudoku_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e692ad991693d041" hs_bindgen_e692ad991693d041 :: +hs_bindgen_e692ad991693d041 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +hs_bindgen_e692ad991693d041 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e692ad991693d041_base {-# NOINLINE sudoku_ptr #-} @@ -131,10 +160,17 @@ sudoku_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) ((HsBin sudoku_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e692ad991693d041 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_04df9f2a3065bb07" hs_bindgen_04df9f2a3065bb07_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)))) + {-| __unique:__ @test_manualarrays_Example_get_triplets_ptr@ -} -foreign import ccall unsafe "hs_bindgen_04df9f2a3065bb07" hs_bindgen_04df9f2a3065bb07 :: +hs_bindgen_04df9f2a3065bb07 :: IO (Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) +hs_bindgen_04df9f2a3065bb07 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_04df9f2a3065bb07_base {-# NOINLINE triplets_ptr #-} @@ -150,10 +186,17 @@ triplets_ptr :: Ptr.Ptr (HsBindgen.Runtime.IncompleteArray.IncompleteArray ((HsB triplets_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_04df9f2a3065bb07 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_7d8d8251f0367f2e" hs_bindgen_7d8d8251f0367f2e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Triplet_ptrs)) + {-| __unique:__ @test_manualarrays_Example_get_global_triplet_ptrs_ptr@ -} -foreign import ccall unsafe "hs_bindgen_7d8d8251f0367f2e" hs_bindgen_7d8d8251f0367f2e :: +hs_bindgen_7d8d8251f0367f2e :: IO (Ptr.Ptr Triplet_ptrs) +hs_bindgen_7d8d8251f0367f2e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_7d8d8251f0367f2e_base {-# NOINLINE global_triplet_ptrs_ptr #-} diff --git a/hs-bindgen/fixtures/manual/arrays/Example/Safe.hs b/hs-bindgen/fixtures/manual/arrays/Example/Safe.hs index 1f7419c58..52a0ea5ee 100644 --- a/hs-bindgen/fixtures/manual/arrays/Example/Safe.hs +++ b/hs-bindgen/fixtures/manual/arrays/Example/Safe.hs @@ -9,6 +9,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -30,14 +31,21 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cba7011c6d25362b" transpose_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Triplet) -> (Ptr.Ptr Triplet) -> IO ()) + {-| Pointer-based API for 'transpose' __unique:__ @test_manualarrays_Example_Safe_transpose@ -} -foreign import ccall safe "hs_bindgen_cba7011c6d25362b" transpose_wrapper :: +transpose_wrapper :: Ptr.Ptr Triplet -> Ptr.Ptr Triplet -> IO () +transpose_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType transpose_wrapper_base {-| __C declaration:__ @transpose@ @@ -59,6 +67,11 @@ transpose = HsBindgen.Runtime.ConstantArray.withPtr x0 (\ptr2 -> transpose_wrapper ptr2 x1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_45d15697a99c626a" pretty_print_triplets_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) -> IO ()) + {-| A function that prints the given triplet_ptrs __C declaration:__ @pretty_print_triplets@ @@ -69,8 +82,10 @@ __exported by:__ @manual\/arrays.h@ __unique:__ @test_manualarrays_Example_Safe_pretty_print_triplets@ -} -foreign import ccall safe "hs_bindgen_45d15697a99c626a" pretty_print_triplets :: +pretty_print_triplets :: Ptr.Ptr (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) {- ^ __C declaration:__ @x@ -} -> IO () +pretty_print_triplets = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType pretty_print_triplets_base diff --git a/hs-bindgen/fixtures/manual/arrays/Example/Unsafe.hs b/hs-bindgen/fixtures/manual/arrays/Example/Unsafe.hs index 5dc627eb8..b0dfcbf89 100644 --- a/hs-bindgen/fixtures/manual/arrays/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/manual/arrays/Example/Unsafe.hs @@ -9,6 +9,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -30,14 +31,21 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f9f2776d121db261" transpose_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Triplet) -> (Ptr.Ptr Triplet) -> IO ()) + {-| Pointer-based API for 'transpose' __unique:__ @test_manualarrays_Example_Unsafe_transpose@ -} -foreign import ccall unsafe "hs_bindgen_f9f2776d121db261" transpose_wrapper :: +transpose_wrapper :: Ptr.Ptr Triplet -> Ptr.Ptr Triplet -> IO () +transpose_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType transpose_wrapper_base {-| __C declaration:__ @transpose@ @@ -59,6 +67,11 @@ transpose = HsBindgen.Runtime.ConstantArray.withPtr x0 (\ptr2 -> transpose_wrapper ptr2 x1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e43b4d44aa0abd14" pretty_print_triplets_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt))) -> IO ()) + {-| A function that prints the given triplet_ptrs __C declaration:__ @pretty_print_triplets@ @@ -69,8 +82,10 @@ __exported by:__ @manual\/arrays.h@ __unique:__ @test_manualarrays_Example_Unsafe_pretty_print_triplets@ -} -foreign import ccall unsafe "hs_bindgen_e43b4d44aa0abd14" pretty_print_triplets :: +pretty_print_triplets :: Ptr.Ptr (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 3) FC.CInt)) {- ^ __C declaration:__ @x@ -} -> IO () +pretty_print_triplets = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType pretty_print_triplets_base diff --git a/hs-bindgen/fixtures/manual/arrays/th.txt b/hs-bindgen/fixtures/manual/arrays/th.txt index 9161f0275..65218d4ea 100644 --- a/hs-bindgen/fixtures/manual/arrays/th.txt +++ b/hs-bindgen/fixtures/manual/arrays/th.txt @@ -150,12 +150,21 @@ instance HasCField Triplet_ptrs "un_Triplet_ptrs" where type CFieldType Triplet_ptrs "un_Triplet_ptrs" = IncompleteArray (Ptr (ConstantArray 3 CInt)) offset# = \_ -> \_ -> 0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cba7011c6d25362b" transpose_wrapper_base :: BaseForeignType (Ptr Triplet -> + Ptr Triplet -> + IO Unit) {-| Pointer-based API for 'transpose' __unique:__ @test_manualarrays_Example_Unsafe_transpose@ -} -foreign import ccall safe "hs_bindgen_cba7011c6d25362b" transpose_wrapper :: Ptr Triplet -> - Ptr Triplet -> IO Unit +transpose_wrapper :: Ptr Triplet -> Ptr Triplet -> IO Unit +{-| Pointer-based API for 'transpose' + +__unique:__ @test_manualarrays_Example_Unsafe_transpose@ +-} +transpose_wrapper = fromBaseForeignType transpose_wrapper_base {-| __C declaration:__ @transpose@ __defined at:__ @manual\/arrays.h:36:6@ @@ -170,6 +179,23 @@ transpose :: Matrix -> Ptr Triplet -> IO Unit __exported by:__ @manual\/arrays.h@ -} transpose = \x_0 -> \x_1 -> withPtr x_0 (\ptr_2 -> transpose_wrapper ptr_2 x_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_45d15697a99c626a" pretty_print_triplets_base :: BaseForeignType (Ptr (Ptr (ConstantArray 3 + CInt)) -> + IO Unit) +{-| A function that prints the given triplet_ptrs + +__C declaration:__ @pretty_print_triplets@ + +__defined at:__ @manual\/arrays.h:50:13@ + +__exported by:__ @manual\/arrays.h@ + +__unique:__ @test_manualarrays_Example_Unsafe_pretty_print_triplets@ +-} +pretty_print_triplets :: Ptr (Ptr (ConstantArray 3 CInt)) -> + IO Unit {-| A function that prints the given triplet_ptrs __C declaration:__ @pretty_print_triplets@ @@ -180,15 +206,22 @@ __exported by:__ @manual\/arrays.h@ __unique:__ @test_manualarrays_Example_Unsafe_pretty_print_triplets@ -} -foreign import ccall safe "hs_bindgen_45d15697a99c626a" pretty_print_triplets :: Ptr (Ptr (ConstantArray 3 - CInt)) -> - IO Unit +pretty_print_triplets = fromBaseForeignType pretty_print_triplets_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f9f2776d121db261" transpose_wrapper_base :: BaseForeignType (Ptr Triplet -> + Ptr Triplet -> + IO Unit) +{-| Pointer-based API for 'transpose' + +__unique:__ @test_manualarrays_Example_Unsafe_transpose@ +-} +transpose_wrapper :: Ptr Triplet -> Ptr Triplet -> IO Unit {-| Pointer-based API for 'transpose' __unique:__ @test_manualarrays_Example_Unsafe_transpose@ -} -foreign import ccall safe "hs_bindgen_f9f2776d121db261" transpose_wrapper :: Ptr Triplet -> - Ptr Triplet -> IO Unit +transpose_wrapper = fromBaseForeignType transpose_wrapper_base {-| __C declaration:__ @transpose@ __defined at:__ @manual\/arrays.h:36:6@ @@ -203,6 +236,23 @@ transpose :: Matrix -> Ptr Triplet -> IO Unit __exported by:__ @manual\/arrays.h@ -} transpose = \x_0 -> \x_1 -> withPtr x_0 (\ptr_2 -> transpose_wrapper ptr_2 x_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e43b4d44aa0abd14" pretty_print_triplets_base :: BaseForeignType (Ptr (Ptr (ConstantArray 3 + CInt)) -> + IO Unit) +{-| A function that prints the given triplet_ptrs + +__C declaration:__ @pretty_print_triplets@ + +__defined at:__ @manual\/arrays.h:50:13@ + +__exported by:__ @manual\/arrays.h@ + +__unique:__ @test_manualarrays_Example_Unsafe_pretty_print_triplets@ +-} +pretty_print_triplets :: Ptr (Ptr (ConstantArray 3 CInt)) -> + IO Unit {-| A function that prints the given triplet_ptrs __C declaration:__ @pretty_print_triplets@ @@ -213,14 +263,19 @@ __exported by:__ @manual\/arrays.h@ __unique:__ @test_manualarrays_Example_Unsafe_pretty_print_triplets@ -} -foreign import ccall safe "hs_bindgen_e43b4d44aa0abd14" pretty_print_triplets :: Ptr (Ptr (ConstantArray 3 - CInt)) -> - IO Unit +pretty_print_triplets = fromBaseForeignType pretty_print_triplets_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_24c867a3e91cab5d" hs_bindgen_24c867a3e91cab5d_base :: BaseForeignType (IO (FunPtr (Matrix -> + Matrix -> + IO Unit))) +{-| __unique:__ @test_manualarrays_Example_get_transpose_ptr@ +-} +hs_bindgen_24c867a3e91cab5d :: IO (FunPtr (Matrix -> + Matrix -> IO Unit)) {-| __unique:__ @test_manualarrays_Example_get_transpose_ptr@ -} -foreign import ccall safe "hs_bindgen_24c867a3e91cab5d" hs_bindgen_24c867a3e91cab5d :: IO (FunPtr (Matrix -> - Matrix -> - IO Unit)) +hs_bindgen_24c867a3e91cab5d = fromBaseForeignType hs_bindgen_24c867a3e91cab5d_base {-# NOINLINE transpose_ptr #-} {-| __C declaration:__ @transpose@ @@ -236,10 +291,17 @@ transpose_ptr :: FunPtr (Matrix -> Matrix -> IO Unit) __exported by:__ @manual\/arrays.h@ -} transpose_ptr = unsafePerformIO hs_bindgen_24c867a3e91cab5d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_66af82cae0c5134a" hs_bindgen_66af82cae0c5134a_base :: BaseForeignType (IO (FunPtr (Triplet_ptrs -> + IO Unit))) +{-| __unique:__ @test_manualarrays_Example_get_pretty_print_triplets_ptr@ +-} +hs_bindgen_66af82cae0c5134a :: IO (FunPtr (Triplet_ptrs -> + IO Unit)) {-| __unique:__ @test_manualarrays_Example_get_pretty_print_triplets_ptr@ -} -foreign import ccall safe "hs_bindgen_66af82cae0c5134a" hs_bindgen_66af82cae0c5134a :: IO (FunPtr (Triplet_ptrs -> - IO Unit)) +hs_bindgen_66af82cae0c5134a = fromBaseForeignType hs_bindgen_66af82cae0c5134a_base {-# NOINLINE pretty_print_triplets_ptr #-} {-| A function that prints the given triplet_ptrs @@ -259,10 +321,16 @@ __defined at:__ @manual\/arrays.h:50:13@ __exported by:__ @manual\/arrays.h@ -} pretty_print_triplets_ptr = unsafePerformIO hs_bindgen_66af82cae0c5134a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_57b6693818620aec" hs_bindgen_57b6693818620aec_base :: BaseForeignType (IO (Ptr (ConstantArray 1 + CInt))) {-| __unique:__ @test_manualarrays_Example_get_arr1_ptr@ -} -foreign import ccall safe "hs_bindgen_57b6693818620aec" hs_bindgen_57b6693818620aec :: IO (Ptr (ConstantArray 1 - CInt)) +hs_bindgen_57b6693818620aec :: IO (Ptr (ConstantArray 1 CInt)) +{-| __unique:__ @test_manualarrays_Example_get_arr1_ptr@ +-} +hs_bindgen_57b6693818620aec = fromBaseForeignType hs_bindgen_57b6693818620aec_base {-# NOINLINE arr1_ptr #-} {-| Global, complete, initialised @@ -282,10 +350,16 @@ __defined at:__ @manual\/arrays.h:13:12@ __exported by:__ @manual\/arrays.h@ -} arr1_ptr = unsafePerformIO hs_bindgen_57b6693818620aec +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_928e8bd0dc2d0be1" hs_bindgen_928e8bd0dc2d0be1_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + CInt))) {-| __unique:__ @test_manualarrays_Example_get_arr2_ptr@ -} -foreign import ccall safe "hs_bindgen_928e8bd0dc2d0be1" hs_bindgen_928e8bd0dc2d0be1 :: IO (Ptr (ConstantArray 3 - CInt)) +hs_bindgen_928e8bd0dc2d0be1 :: IO (Ptr (ConstantArray 3 CInt)) +{-| __unique:__ @test_manualarrays_Example_get_arr2_ptr@ +-} +hs_bindgen_928e8bd0dc2d0be1 = fromBaseForeignType hs_bindgen_928e8bd0dc2d0be1_base {-# NOINLINE arr2_ptr #-} {-| Global, extern, complete, not initialised @@ -305,9 +379,15 @@ __defined at:__ @manual\/arrays.h:16:12@ __exported by:__ @manual\/arrays.h@ -} arr2_ptr = unsafePerformIO hs_bindgen_928e8bd0dc2d0be1 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e6493a6ad08768b6" hs_bindgen_e6493a6ad08768b6_base :: BaseForeignType (IO (Ptr (IncompleteArray CInt))) {-| __unique:__ @test_manualarrays_Example_get_arr3_ptr@ -} -foreign import ccall safe "hs_bindgen_e6493a6ad08768b6" hs_bindgen_e6493a6ad08768b6 :: IO (Ptr (IncompleteArray CInt)) +hs_bindgen_e6493a6ad08768b6 :: IO (Ptr (IncompleteArray CInt)) +{-| __unique:__ @test_manualarrays_Example_get_arr3_ptr@ +-} +hs_bindgen_e6493a6ad08768b6 = fromBaseForeignType hs_bindgen_e6493a6ad08768b6_base {-# NOINLINE arr3_ptr #-} {-| Global, extern, incomplete @@ -327,11 +407,18 @@ __defined at:__ @manual\/arrays.h:19:12@ __exported by:__ @manual\/arrays.h@ -} arr3_ptr = unsafePerformIO hs_bindgen_e6493a6ad08768b6 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e692ad991693d041" hs_bindgen_e692ad991693d041_base :: BaseForeignType (IO (Ptr (ConstantArray 3 + (ConstantArray 3 + CInt)))) +{-| __unique:__ @test_manualarrays_Example_get_sudoku_ptr@ +-} +hs_bindgen_e692ad991693d041 :: IO (Ptr (ConstantArray 3 + (ConstantArray 3 CInt))) {-| __unique:__ @test_manualarrays_Example_get_sudoku_ptr@ -} -foreign import ccall safe "hs_bindgen_e692ad991693d041" hs_bindgen_e692ad991693d041 :: IO (Ptr (ConstantArray 3 - (ConstantArray 3 - CInt))) +hs_bindgen_e692ad991693d041 = fromBaseForeignType hs_bindgen_e692ad991693d041_base {-# NOINLINE sudoku_ptr #-} {-| Multi-dimensional array of known size. @@ -351,10 +438,17 @@ __defined at:__ @manual\/arrays.h:22:12@ __exported by:__ @manual\/arrays.h@ -} sudoku_ptr = unsafePerformIO hs_bindgen_e692ad991693d041 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_04df9f2a3065bb07" hs_bindgen_04df9f2a3065bb07_base :: BaseForeignType (IO (Ptr (IncompleteArray (ConstantArray 3 + CInt)))) +{-| __unique:__ @test_manualarrays_Example_get_triplets_ptr@ +-} +hs_bindgen_04df9f2a3065bb07 :: IO (Ptr (IncompleteArray (ConstantArray 3 + CInt))) {-| __unique:__ @test_manualarrays_Example_get_triplets_ptr@ -} -foreign import ccall safe "hs_bindgen_04df9f2a3065bb07" hs_bindgen_04df9f2a3065bb07 :: IO (Ptr (IncompleteArray (ConstantArray 3 - CInt))) +hs_bindgen_04df9f2a3065bb07 = fromBaseForeignType hs_bindgen_04df9f2a3065bb07_base {-# NOINLINE triplets_ptr #-} {-| Multi-dimensional array of unknown size. Only the first dimension is allowed to be unknown. @@ -374,9 +468,15 @@ __defined at:__ @manual\/arrays.h:26:12@ __exported by:__ @manual\/arrays.h@ -} triplets_ptr = unsafePerformIO hs_bindgen_04df9f2a3065bb07 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_7d8d8251f0367f2e" hs_bindgen_7d8d8251f0367f2e_base :: BaseForeignType (IO (Ptr Triplet_ptrs)) +{-| __unique:__ @test_manualarrays_Example_get_global_triplet_ptrs_ptr@ +-} +hs_bindgen_7d8d8251f0367f2e :: IO (Ptr Triplet_ptrs) {-| __unique:__ @test_manualarrays_Example_get_global_triplet_ptrs_ptr@ -} -foreign import ccall safe "hs_bindgen_7d8d8251f0367f2e" hs_bindgen_7d8d8251f0367f2e :: IO (Ptr Triplet_ptrs) +hs_bindgen_7d8d8251f0367f2e = fromBaseForeignType hs_bindgen_7d8d8251f0367f2e_base {-# NOINLINE global_triplet_ptrs_ptr #-} {-| A global of triplet_ptrs diff --git a/hs-bindgen/fixtures/manual/function_pointers/Example/FunPtr.hs b/hs-bindgen/fixtures/manual/function_pointers/Example/FunPtr.hs index 6856e688d..8df20e3c9 100644 --- a/hs-bindgen/fixtures/manual/function_pointers/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/manual/function_pointers/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -84,10 +85,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1820f088ae031e75" hs_bindgen_1820f088ae031e75_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_manualfunction_pointers_Example_get_square_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1820f088ae031e75" hs_bindgen_1820f088ae031e75 :: +hs_bindgen_1820f088ae031e75 :: IO (Ptr.FunPtr (FC.CInt -> IO FC.CInt)) +hs_bindgen_1820f088ae031e75 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1820f088ae031e75_base {-# NOINLINE square_ptr #-} @@ -101,10 +109,17 @@ square_ptr :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) square_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1820f088ae031e75 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_bbf0ff803f52cc45" hs_bindgen_bbf0ff803f52cc45_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_manualfunction_pointers_Example_get_plus_ptr@ -} -foreign import ccall unsafe "hs_bindgen_bbf0ff803f52cc45" hs_bindgen_bbf0ff803f52cc45 :: +hs_bindgen_bbf0ff803f52cc45 :: IO (Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt)) +hs_bindgen_bbf0ff803f52cc45 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_bbf0ff803f52cc45_base {-# NOINLINE plus_ptr #-} @@ -118,10 +133,17 @@ plus_ptr :: Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt) plus_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_bbf0ff803f52cc45 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9515a684c6197849" hs_bindgen_9515a684c6197849_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9515a684c6197849" hs_bindgen_9515a684c6197849 :: +hs_bindgen_9515a684c6197849 :: IO (Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> FC.CInt -> IO FC.CInt)) +hs_bindgen_9515a684c6197849 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9515a684c6197849_base {-# NOINLINE apply1_ptr #-} @@ -135,10 +157,17 @@ apply1_ptr :: Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> FC.CInt -> IO apply1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9515a684c6197849 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1bf5d46d7038cf34" hs_bindgen_1bf5d46d7038cf34_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt)) -> FC.CInt -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_manualfunction_pointers_Example_get_apply2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1bf5d46d7038cf34" hs_bindgen_1bf5d46d7038cf34 :: +hs_bindgen_1bf5d46d7038cf34 :: IO (Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt)) -> FC.CInt -> FC.CInt -> IO FC.CInt)) +hs_bindgen_1bf5d46d7038cf34 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1bf5d46d7038cf34_base {-# NOINLINE apply2_ptr #-} @@ -152,10 +181,17 @@ apply2_ptr :: Ptr.FunPtr ((Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt)) -> FC. apply2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1bf5d46d7038cf34 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_95e560983f86bd1d" hs_bindgen_95e560983f86bd1d_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_pointer_arg_ptr@ -} -foreign import ccall unsafe "hs_bindgen_95e560983f86bd1d" hs_bindgen_95e560983f86bd1d :: +hs_bindgen_95e560983f86bd1d :: IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt)) +hs_bindgen_95e560983f86bd1d = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_95e560983f86bd1d_base {-# NOINLINE apply1_pointer_arg_ptr #-} @@ -171,10 +207,17 @@ apply1_pointer_arg_ptr :: Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.C apply1_pointer_arg_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_95e560983f86bd1d +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_9738799dd67af2e9" hs_bindgen_9738799dd67af2e9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt))) + {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_nopointer_arg_ptr@ -} -foreign import ccall unsafe "hs_bindgen_9738799dd67af2e9" hs_bindgen_9738799dd67af2e9 :: +hs_bindgen_9738799dd67af2e9 :: IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt)) +hs_bindgen_9738799dd67af2e9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_9738799dd67af2e9_base {-# NOINLINE apply1_nopointer_arg_ptr #-} @@ -190,10 +233,17 @@ apply1_nopointer_arg_ptr :: Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC apply1_nopointer_arg_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_9738799dd67af2e9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c9d47a6b0f980aa5" hs_bindgen_c9d47a6b0f980aa5_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt))))) + {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_nopointer_res_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c9d47a6b0f980aa5" hs_bindgen_c9d47a6b0f980aa5 :: +hs_bindgen_c9d47a6b0f980aa5 :: IO (Ptr.FunPtr (IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt)))) +hs_bindgen_c9d47a6b0f980aa5 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c9d47a6b0f980aa5_base {-# NOINLINE apply1_nopointer_res_ptr #-} diff --git a/hs-bindgen/fixtures/manual/function_pointers/Example/Global.hs b/hs-bindgen/fixtures/manual/function_pointers/Example/Global.hs index d0dc0ab49..92ea7e13c 100644 --- a/hs-bindgen/fixtures/manual/function_pointers/Example/Global.hs +++ b/hs-bindgen/fixtures/manual/function_pointers/Example/Global.hs @@ -9,6 +9,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -38,10 +39,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ab897ed3a6702a69" hs_bindgen_ab897ed3a6702a69_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt)))) + {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_nopointer_var_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ab897ed3a6702a69" hs_bindgen_ab897ed3a6702a69 :: +hs_bindgen_ab897ed3a6702a69 :: IO (Ptr.Ptr (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt))) +hs_bindgen_ab897ed3a6702a69 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ab897ed3a6702a69_base {-# NOINLINE apply1_nopointer_var_ptr #-} @@ -63,10 +71,17 @@ apply1_nopointer_var :: Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CIn apply1_nopointer_var = GHC.IO.Unsafe.unsafePerformIO (F.peek apply1_nopointer_var_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_448bdc6115d5924e" hs_bindgen_448bdc6115d5924e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Apply1Struct)) + {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_struct_ptr@ -} -foreign import ccall unsafe "hs_bindgen_448bdc6115d5924e" hs_bindgen_448bdc6115d5924e :: +hs_bindgen_448bdc6115d5924e :: IO (Ptr.Ptr Apply1Struct) +hs_bindgen_448bdc6115d5924e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_448bdc6115d5924e_base {-# NOINLINE apply1_struct_ptr #-} @@ -86,10 +101,17 @@ apply1_struct :: Apply1Struct apply1_struct = GHC.IO.Unsafe.unsafePerformIO (F.peek apply1_struct_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3f47656e6bb54e94" hs_bindgen_3f47656e6bb54e94_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr Apply1Union)) + {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_union_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3f47656e6bb54e94" hs_bindgen_3f47656e6bb54e94 :: +hs_bindgen_3f47656e6bb54e94 :: IO (Ptr.Ptr Apply1Union) +hs_bindgen_3f47656e6bb54e94 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3f47656e6bb54e94_base {-# NOINLINE apply1_union_ptr #-} diff --git a/hs-bindgen/fixtures/manual/function_pointers/Example/Safe.hs b/hs-bindgen/fixtures/manual/function_pointers/Example/Safe.hs index 05837073e..34a1db35d 100644 --- a/hs-bindgen/fixtures/manual/function_pointers/Example/Safe.hs +++ b/hs-bindgen/fixtures/manual/function_pointers/Example/Safe.hs @@ -7,6 +7,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -69,6 +70,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8c6beff641297a13" square_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) + {-| __C declaration:__ @square@ __defined at:__ @manual\/function_pointers.h:5:12@ @@ -77,9 +83,16 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_manualfunction_pointers_Example_Safe_square@ -} -foreign import ccall safe "hs_bindgen_8c6beff641297a13" square :: +square :: FC.CInt -> IO FC.CInt +square = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3dfb239ac098f471" plus_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @plus@ @@ -89,10 +102,17 @@ foreign import ccall safe "hs_bindgen_8c6beff641297a13" square :: __unique:__ @test_manualfunction_pointers_Example_Safe_plus@ -} -foreign import ccall safe "hs_bindgen_3dfb239ac098f471" plus :: +plus :: FC.CInt -> FC.CInt -> IO FC.CInt +plus = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType plus_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_983beb37938c4d96" apply1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @apply1@ @@ -102,7 +122,7 @@ foreign import ccall safe "hs_bindgen_3dfb239ac098f471" plus :: __unique:__ @test_manualfunction_pointers_Example_Safe_apply1@ -} -foreign import ccall safe "hs_bindgen_983beb37938c4d96" apply1 :: +apply1 :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) {- ^ __C declaration:__ @f@ -} @@ -110,6 +130,13 @@ foreign import ccall safe "hs_bindgen_983beb37938c4d96" apply1 :: {- ^ __C declaration:__ @x@ -} -> IO FC.CInt +apply1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply1_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8a62074f5475563b" apply2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt)) -> FC.CInt -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @apply2@ @@ -119,7 +146,7 @@ foreign import ccall safe "hs_bindgen_983beb37938c4d96" apply1 :: __unique:__ @test_manualfunction_pointers_Example_Safe_apply2@ -} -foreign import ccall safe "hs_bindgen_8a62074f5475563b" apply2 :: +apply2 :: Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt) {- ^ __C declaration:__ @f@ -} @@ -130,6 +157,13 @@ foreign import ccall safe "hs_bindgen_8a62074f5475563b" apply2 :: {- ^ __C declaration:__ @y@ -} -> IO FC.CInt +apply2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply2_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_229d4041a92cd6b6" apply1_pointer_arg_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt) {-| Basically the same as apply1(), but here for illustratory purposes. @@ -141,10 +175,17 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Safe_apply1_pointer_arg@ -} -foreign import ccall safe "hs_bindgen_229d4041a92cd6b6" apply1_pointer_arg :: +apply1_pointer_arg :: Ptr.FunPtr Int2int -> FC.CInt -> IO FC.CInt +apply1_pointer_arg = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply1_pointer_arg_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_de9f1109e03648e4" apply1_nopointer_arg_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt) {-| A version of apply1_pointer_arg() that declares to take a argument of function type, rather than a pointer-to-function type. @@ -156,10 +197,17 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Safe_apply1_nopointer_arg@ -} -foreign import ccall safe "hs_bindgen_de9f1109e03648e4" apply1_nopointer_arg :: +apply1_nopointer_arg :: Ptr.FunPtr Int2int -> FC.CInt -> IO FC.CInt +apply1_nopointer_arg = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply1_nopointer_arg_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8bea6b2106c55d5b" apply1_nopointer_res_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt))) {-| A function returning a pointer to a function like apply1_nopointer(). @@ -171,5 +219,7 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Safe_apply1_nopointer_res@ -} -foreign import ccall safe "hs_bindgen_8bea6b2106c55d5b" apply1_nopointer_res :: +apply1_nopointer_res :: IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt)) +apply1_nopointer_res = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply1_nopointer_res_base diff --git a/hs-bindgen/fixtures/manual/function_pointers/Example/Unsafe.hs b/hs-bindgen/fixtures/manual/function_pointers/Example/Unsafe.hs index 0f233f999..d958c5904 100644 --- a/hs-bindgen/fixtures/manual/function_pointers/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/manual/function_pointers/Example/Unsafe.hs @@ -7,6 +7,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -69,6 +70,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_db669c022bc12e81" square_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO FC.CInt) + {-| __C declaration:__ @square@ __defined at:__ @manual\/function_pointers.h:5:12@ @@ -77,9 +83,16 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_manualfunction_pointers_Example_Unsafe_square@ -} -foreign import ccall unsafe "hs_bindgen_db669c022bc12e81" square :: +square :: FC.CInt -> IO FC.CInt +square = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType square_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0bb46b9dde136391" plus_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @plus@ @@ -89,10 +102,17 @@ foreign import ccall unsafe "hs_bindgen_db669c022bc12e81" square :: __unique:__ @test_manualfunction_pointers_Example_Unsafe_plus@ -} -foreign import ccall unsafe "hs_bindgen_0bb46b9dde136391" plus :: +plus :: FC.CInt -> FC.CInt -> IO FC.CInt +plus = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType plus_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3ff551d60859d359" apply1_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (FC.CInt -> IO FC.CInt)) -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @apply1@ @@ -102,7 +122,7 @@ foreign import ccall unsafe "hs_bindgen_0bb46b9dde136391" plus :: __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1@ -} -foreign import ccall unsafe "hs_bindgen_3ff551d60859d359" apply1 :: +apply1 :: Ptr.FunPtr (FC.CInt -> IO FC.CInt) {- ^ __C declaration:__ @f@ -} @@ -110,6 +130,13 @@ foreign import ccall unsafe "hs_bindgen_3ff551d60859d359" apply1 :: {- ^ __C declaration:__ @x@ -} -> IO FC.CInt +apply1 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply1_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4c92d113161d27cf" apply2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt)) -> FC.CInt -> FC.CInt -> IO FC.CInt) {-| __C declaration:__ @apply2@ @@ -119,7 +146,7 @@ foreign import ccall unsafe "hs_bindgen_3ff551d60859d359" apply1 :: __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply2@ -} -foreign import ccall unsafe "hs_bindgen_4c92d113161d27cf" apply2 :: +apply2 :: Ptr.FunPtr (FC.CInt -> FC.CInt -> IO FC.CInt) {- ^ __C declaration:__ @f@ -} @@ -130,6 +157,13 @@ foreign import ccall unsafe "hs_bindgen_4c92d113161d27cf" apply2 :: {- ^ __C declaration:__ @y@ -} -> IO FC.CInt +apply2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply2_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_2f904bf3ce7a5f06" apply1_pointer_arg_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt) {-| Basically the same as apply1(), but here for illustratory purposes. @@ -141,10 +175,17 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_pointer_arg@ -} -foreign import ccall unsafe "hs_bindgen_2f904bf3ce7a5f06" apply1_pointer_arg :: +apply1_pointer_arg :: Ptr.FunPtr Int2int -> FC.CInt -> IO FC.CInt +apply1_pointer_arg = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply1_pointer_arg_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_966092b638965558" apply1_nopointer_arg_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt) {-| A version of apply1_pointer_arg() that declares to take a argument of function type, rather than a pointer-to-function type. @@ -156,10 +197,17 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_arg@ -} -foreign import ccall unsafe "hs_bindgen_966092b638965558" apply1_nopointer_arg :: +apply1_nopointer_arg :: Ptr.FunPtr Int2int -> FC.CInt -> IO FC.CInt +apply1_nopointer_arg = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply1_nopointer_arg_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_99a8340e6e6029c5" apply1_nopointer_res_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt))) {-| A function returning a pointer to a function like apply1_nopointer(). @@ -171,5 +219,7 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_res@ -} -foreign import ccall unsafe "hs_bindgen_99a8340e6e6029c5" apply1_nopointer_res :: +apply1_nopointer_res :: IO (Ptr.FunPtr ((Ptr.FunPtr Int2int) -> FC.CInt -> IO FC.CInt)) +apply1_nopointer_res = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType apply1_nopointer_res_base diff --git a/hs-bindgen/fixtures/manual/function_pointers/th.txt b/hs-bindgen/fixtures/manual/function_pointers/th.txt index d969f49e1..f907dd666 100644 --- a/hs-bindgen/fixtures/manual/function_pointers/th.txt +++ b/hs-bindgen/fixtures/manual/function_pointers/th.txt @@ -355,6 +355,10 @@ instance ToFunPtr (FunPtr Int2int -> CInt -> IO CInt) where toFunPtr = hs_bindgen_fe02c1e534fc52ea instance FromFunPtr (FunPtr Int2int -> CInt -> IO CInt) where fromFunPtr = hs_bindgen_fc27363846cb6139 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8c6beff641297a13" square_base :: BaseForeignType (CInt -> + IO CInt) {-| __C declaration:__ @square@ __defined at:__ @manual\/function_pointers.h:5:12@ @@ -363,8 +367,21 @@ instance FromFunPtr (FunPtr Int2int -> CInt -> IO CInt) __unique:__ @test_manualfunction_pointers_Example_Unsafe_square@ -} -foreign import ccall safe "hs_bindgen_8c6beff641297a13" square :: CInt -> - IO CInt +square :: CInt -> IO CInt +{-| __C declaration:__ @square@ + + __defined at:__ @manual\/function_pointers.h:5:12@ + + __exported by:__ @manual\/function_pointers.h@ + + __unique:__ @test_manualfunction_pointers_Example_Unsafe_square@ +-} +square = fromBaseForeignType square_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3dfb239ac098f471" plus_base :: BaseForeignType (CInt -> + CInt -> + IO CInt) {-| __C declaration:__ @plus@ __defined at:__ @manual\/function_pointers.h:7:12@ @@ -373,8 +390,31 @@ foreign import ccall safe "hs_bindgen_8c6beff641297a13" square :: CInt -> __unique:__ @test_manualfunction_pointers_Example_Unsafe_plus@ -} -foreign import ccall safe "hs_bindgen_3dfb239ac098f471" plus :: CInt -> - CInt -> IO CInt +plus :: CInt -> CInt -> IO CInt +{-| __C declaration:__ @plus@ + + __defined at:__ @manual\/function_pointers.h:7:12@ + + __exported by:__ @manual\/function_pointers.h@ + + __unique:__ @test_manualfunction_pointers_Example_Unsafe_plus@ +-} +plus = fromBaseForeignType plus_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_983beb37938c4d96" apply1_base :: BaseForeignType (FunPtr (CInt -> + IO CInt) -> + CInt -> + IO CInt) +{-| __C declaration:__ @apply1@ + + __defined at:__ @manual\/function_pointers.h:9:12@ + + __exported by:__ @manual\/function_pointers.h@ + + __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1@ +-} +apply1 :: FunPtr (CInt -> IO CInt) -> CInt -> IO CInt {-| __C declaration:__ @apply1@ __defined at:__ @manual\/function_pointers.h:9:12@ @@ -383,9 +423,15 @@ foreign import ccall safe "hs_bindgen_3dfb239ac098f471" plus :: CInt -> __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1@ -} -foreign import ccall safe "hs_bindgen_983beb37938c4d96" apply1 :: FunPtr (CInt -> - IO CInt) -> - CInt -> IO CInt +apply1 = fromBaseForeignType apply1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8a62074f5475563b" apply2_base :: BaseForeignType (FunPtr (CInt -> + CInt -> + IO CInt) -> + CInt -> + CInt -> + IO CInt) {-| __C declaration:__ @apply2@ __defined at:__ @manual\/function_pointers.h:11:12@ @@ -394,9 +440,33 @@ foreign import ccall safe "hs_bindgen_983beb37938c4d96" apply1 :: FunPtr (CInt - __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply2@ -} -foreign import ccall safe "hs_bindgen_8a62074f5475563b" apply2 :: FunPtr (CInt -> - CInt -> IO CInt) -> - CInt -> CInt -> IO CInt +apply2 :: FunPtr (CInt -> CInt -> IO CInt) -> + CInt -> CInt -> IO CInt +{-| __C declaration:__ @apply2@ + + __defined at:__ @manual\/function_pointers.h:11:12@ + + __exported by:__ @manual\/function_pointers.h@ + + __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply2@ +-} +apply2 = fromBaseForeignType apply2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_229d4041a92cd6b6" apply1_pointer_arg_base :: BaseForeignType (FunPtr Int2int -> + CInt -> + IO CInt) +{-| Basically the same as apply1(), but here for illustratory purposes. + +__C declaration:__ @apply1_pointer_arg@ + +__defined at:__ @manual\/function_pointers.h:22:12@ + +__exported by:__ @manual\/function_pointers.h@ + +__unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_pointer_arg@ +-} +apply1_pointer_arg :: FunPtr Int2int -> CInt -> IO CInt {-| Basically the same as apply1(), but here for illustratory purposes. __C declaration:__ @apply1_pointer_arg@ @@ -407,8 +477,12 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_pointer_arg@ -} -foreign import ccall safe "hs_bindgen_229d4041a92cd6b6" apply1_pointer_arg :: FunPtr Int2int -> - CInt -> IO CInt +apply1_pointer_arg = fromBaseForeignType apply1_pointer_arg_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_de9f1109e03648e4" apply1_nopointer_arg_base :: BaseForeignType (FunPtr Int2int -> + CInt -> + IO CInt) {-| A version of apply1_pointer_arg() that declares to take a argument of function type, rather than a pointer-to-function type. __C declaration:__ @apply1_nopointer_arg@ @@ -419,8 +493,35 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_arg@ -} -foreign import ccall safe "hs_bindgen_de9f1109e03648e4" apply1_nopointer_arg :: FunPtr Int2int -> - CInt -> IO CInt +apply1_nopointer_arg :: FunPtr Int2int -> CInt -> IO CInt +{-| A version of apply1_pointer_arg() that declares to take a argument of function type, rather than a pointer-to-function type. + +__C declaration:__ @apply1_nopointer_arg@ + +__defined at:__ @manual\/function_pointers.h:26:12@ + +__exported by:__ @manual\/function_pointers.h@ + +__unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_arg@ +-} +apply1_nopointer_arg = fromBaseForeignType apply1_nopointer_arg_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8bea6b2106c55d5b" apply1_nopointer_res_base :: BaseForeignType (IO (FunPtr (FunPtr Int2int -> + CInt -> + IO CInt))) +{-| A function returning a pointer to a function like apply1_nopointer(). + +__C declaration:__ @apply1_nopointer_res@ + +__defined at:__ @manual\/function_pointers.h:31:21@ + +__exported by:__ @manual\/function_pointers.h@ + +__unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_res@ +-} +apply1_nopointer_res :: IO (FunPtr (FunPtr Int2int -> + CInt -> IO CInt)) {-| A function returning a pointer to a function like apply1_nopointer(). __C declaration:__ @apply1_nopointer_res@ @@ -431,9 +532,11 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_res@ -} -foreign import ccall safe "hs_bindgen_8bea6b2106c55d5b" apply1_nopointer_res :: IO (FunPtr (FunPtr Int2int -> - CInt -> - IO CInt)) +apply1_nopointer_res = fromBaseForeignType apply1_nopointer_res_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_db669c022bc12e81" square_base :: BaseForeignType (CInt -> + IO CInt) {-| __C declaration:__ @square@ __defined at:__ @manual\/function_pointers.h:5:12@ @@ -442,8 +545,30 @@ foreign import ccall safe "hs_bindgen_8bea6b2106c55d5b" apply1_nopointer_res :: __unique:__ @test_manualfunction_pointers_Example_Unsafe_square@ -} -foreign import ccall safe "hs_bindgen_db669c022bc12e81" square :: CInt -> - IO CInt +square :: CInt -> IO CInt +{-| __C declaration:__ @square@ + + __defined at:__ @manual\/function_pointers.h:5:12@ + + __exported by:__ @manual\/function_pointers.h@ + + __unique:__ @test_manualfunction_pointers_Example_Unsafe_square@ +-} +square = fromBaseForeignType square_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0bb46b9dde136391" plus_base :: BaseForeignType (CInt -> + CInt -> + IO CInt) +{-| __C declaration:__ @plus@ + + __defined at:__ @manual\/function_pointers.h:7:12@ + + __exported by:__ @manual\/function_pointers.h@ + + __unique:__ @test_manualfunction_pointers_Example_Unsafe_plus@ +-} +plus :: CInt -> CInt -> IO CInt {-| __C declaration:__ @plus@ __defined at:__ @manual\/function_pointers.h:7:12@ @@ -452,8 +577,13 @@ foreign import ccall safe "hs_bindgen_db669c022bc12e81" square :: CInt -> __unique:__ @test_manualfunction_pointers_Example_Unsafe_plus@ -} -foreign import ccall safe "hs_bindgen_0bb46b9dde136391" plus :: CInt -> - CInt -> IO CInt +plus = fromBaseForeignType plus_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3ff551d60859d359" apply1_base :: BaseForeignType (FunPtr (CInt -> + IO CInt) -> + CInt -> + IO CInt) {-| __C declaration:__ @apply1@ __defined at:__ @manual\/function_pointers.h:9:12@ @@ -462,9 +592,34 @@ foreign import ccall safe "hs_bindgen_0bb46b9dde136391" plus :: CInt -> __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1@ -} -foreign import ccall safe "hs_bindgen_3ff551d60859d359" apply1 :: FunPtr (CInt -> - IO CInt) -> - CInt -> IO CInt +apply1 :: FunPtr (CInt -> IO CInt) -> CInt -> IO CInt +{-| __C declaration:__ @apply1@ + + __defined at:__ @manual\/function_pointers.h:9:12@ + + __exported by:__ @manual\/function_pointers.h@ + + __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1@ +-} +apply1 = fromBaseForeignType apply1_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4c92d113161d27cf" apply2_base :: BaseForeignType (FunPtr (CInt -> + CInt -> + IO CInt) -> + CInt -> + CInt -> + IO CInt) +{-| __C declaration:__ @apply2@ + + __defined at:__ @manual\/function_pointers.h:11:12@ + + __exported by:__ @manual\/function_pointers.h@ + + __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply2@ +-} +apply2 :: FunPtr (CInt -> CInt -> IO CInt) -> + CInt -> CInt -> IO CInt {-| __C declaration:__ @apply2@ __defined at:__ @manual\/function_pointers.h:11:12@ @@ -473,9 +628,23 @@ foreign import ccall safe "hs_bindgen_3ff551d60859d359" apply1 :: FunPtr (CInt - __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply2@ -} -foreign import ccall safe "hs_bindgen_4c92d113161d27cf" apply2 :: FunPtr (CInt -> - CInt -> IO CInt) -> - CInt -> CInt -> IO CInt +apply2 = fromBaseForeignType apply2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2f904bf3ce7a5f06" apply1_pointer_arg_base :: BaseForeignType (FunPtr Int2int -> + CInt -> + IO CInt) +{-| Basically the same as apply1(), but here for illustratory purposes. + +__C declaration:__ @apply1_pointer_arg@ + +__defined at:__ @manual\/function_pointers.h:22:12@ + +__exported by:__ @manual\/function_pointers.h@ + +__unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_pointer_arg@ +-} +apply1_pointer_arg :: FunPtr Int2int -> CInt -> IO CInt {-| Basically the same as apply1(), but here for illustratory purposes. __C declaration:__ @apply1_pointer_arg@ @@ -486,8 +655,23 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_pointer_arg@ -} -foreign import ccall safe "hs_bindgen_2f904bf3ce7a5f06" apply1_pointer_arg :: FunPtr Int2int -> - CInt -> IO CInt +apply1_pointer_arg = fromBaseForeignType apply1_pointer_arg_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_966092b638965558" apply1_nopointer_arg_base :: BaseForeignType (FunPtr Int2int -> + CInt -> + IO CInt) +{-| A version of apply1_pointer_arg() that declares to take a argument of function type, rather than a pointer-to-function type. + +__C declaration:__ @apply1_nopointer_arg@ + +__defined at:__ @manual\/function_pointers.h:26:12@ + +__exported by:__ @manual\/function_pointers.h@ + +__unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_arg@ +-} +apply1_nopointer_arg :: FunPtr Int2int -> CInt -> IO CInt {-| A version of apply1_pointer_arg() that declares to take a argument of function type, rather than a pointer-to-function type. __C declaration:__ @apply1_nopointer_arg@ @@ -498,8 +682,12 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_arg@ -} -foreign import ccall safe "hs_bindgen_966092b638965558" apply1_nopointer_arg :: FunPtr Int2int -> - CInt -> IO CInt +apply1_nopointer_arg = fromBaseForeignType apply1_nopointer_arg_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_99a8340e6e6029c5" apply1_nopointer_res_base :: BaseForeignType (IO (FunPtr (FunPtr Int2int -> + CInt -> + IO CInt))) {-| A function returning a pointer to a function like apply1_nopointer(). __C declaration:__ @apply1_nopointer_res@ @@ -510,13 +698,29 @@ __exported by:__ @manual\/function_pointers.h@ __unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_res@ -} -foreign import ccall safe "hs_bindgen_99a8340e6e6029c5" apply1_nopointer_res :: IO (FunPtr (FunPtr Int2int -> - CInt -> - IO CInt)) +apply1_nopointer_res :: IO (FunPtr (FunPtr Int2int -> + CInt -> IO CInt)) +{-| A function returning a pointer to a function like apply1_nopointer(). + +__C declaration:__ @apply1_nopointer_res@ + +__defined at:__ @manual\/function_pointers.h:31:21@ + +__exported by:__ @manual\/function_pointers.h@ + +__unique:__ @test_manualfunction_pointers_Example_Unsafe_apply1_nopointer_res@ +-} +apply1_nopointer_res = fromBaseForeignType apply1_nopointer_res_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1820f088ae031e75" hs_bindgen_1820f088ae031e75_base :: BaseForeignType (IO (FunPtr (CInt -> + IO CInt))) {-| __unique:__ @test_manualfunction_pointers_Example_get_square_ptr@ -} -foreign import ccall safe "hs_bindgen_1820f088ae031e75" hs_bindgen_1820f088ae031e75 :: IO (FunPtr (CInt -> - IO CInt)) +hs_bindgen_1820f088ae031e75 :: IO (FunPtr (CInt -> IO CInt)) +{-| __unique:__ @test_manualfunction_pointers_Example_get_square_ptr@ +-} +hs_bindgen_1820f088ae031e75 = fromBaseForeignType hs_bindgen_1820f088ae031e75_base {-# NOINLINE square_ptr #-} {-| __C declaration:__ @square@ @@ -532,11 +736,18 @@ square_ptr :: FunPtr (CInt -> IO CInt) __exported by:__ @manual\/function_pointers.h@ -} square_ptr = unsafePerformIO hs_bindgen_1820f088ae031e75 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_bbf0ff803f52cc45" hs_bindgen_bbf0ff803f52cc45_base :: BaseForeignType (IO (FunPtr (CInt -> + CInt -> + IO CInt))) {-| __unique:__ @test_manualfunction_pointers_Example_get_plus_ptr@ -} -foreign import ccall safe "hs_bindgen_bbf0ff803f52cc45" hs_bindgen_bbf0ff803f52cc45 :: IO (FunPtr (CInt -> - CInt -> - IO CInt)) +hs_bindgen_bbf0ff803f52cc45 :: IO (FunPtr (CInt -> + CInt -> IO CInt)) +{-| __unique:__ @test_manualfunction_pointers_Example_get_plus_ptr@ +-} +hs_bindgen_bbf0ff803f52cc45 = fromBaseForeignType hs_bindgen_bbf0ff803f52cc45_base {-# NOINLINE plus_ptr #-} {-| __C declaration:__ @plus@ @@ -552,12 +763,20 @@ plus_ptr :: FunPtr (CInt -> CInt -> IO CInt) __exported by:__ @manual\/function_pointers.h@ -} plus_ptr = unsafePerformIO hs_bindgen_bbf0ff803f52cc45 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9515a684c6197849" hs_bindgen_9515a684c6197849_base :: BaseForeignType (IO (FunPtr (FunPtr (CInt -> + IO CInt) -> + CInt -> + IO CInt))) +{-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_ptr@ +-} +hs_bindgen_9515a684c6197849 :: IO (FunPtr (FunPtr (CInt -> + IO CInt) -> + CInt -> IO CInt)) {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_ptr@ -} -foreign import ccall safe "hs_bindgen_9515a684c6197849" hs_bindgen_9515a684c6197849 :: IO (FunPtr (FunPtr (CInt -> - IO CInt) -> - CInt -> - IO CInt)) +hs_bindgen_9515a684c6197849 = fromBaseForeignType hs_bindgen_9515a684c6197849_base {-# NOINLINE apply1_ptr #-} {-| __C declaration:__ @apply1@ @@ -573,14 +792,22 @@ apply1_ptr :: FunPtr (FunPtr (CInt -> IO CInt) -> CInt -> IO CInt) __exported by:__ @manual\/function_pointers.h@ -} apply1_ptr = unsafePerformIO hs_bindgen_9515a684c6197849 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1bf5d46d7038cf34" hs_bindgen_1bf5d46d7038cf34_base :: BaseForeignType (IO (FunPtr (FunPtr (CInt -> + CInt -> + IO CInt) -> + CInt -> + CInt -> + IO CInt))) {-| __unique:__ @test_manualfunction_pointers_Example_get_apply2_ptr@ -} -foreign import ccall safe "hs_bindgen_1bf5d46d7038cf34" hs_bindgen_1bf5d46d7038cf34 :: IO (FunPtr (FunPtr (CInt -> - CInt -> - IO CInt) -> - CInt -> - CInt -> - IO CInt)) +hs_bindgen_1bf5d46d7038cf34 :: IO (FunPtr (FunPtr (CInt -> + CInt -> IO CInt) -> + CInt -> CInt -> IO CInt)) +{-| __unique:__ @test_manualfunction_pointers_Example_get_apply2_ptr@ +-} +hs_bindgen_1bf5d46d7038cf34 = fromBaseForeignType hs_bindgen_1bf5d46d7038cf34_base {-# NOINLINE apply2_ptr #-} {-| __C declaration:__ @apply2@ @@ -597,11 +824,18 @@ apply2_ptr :: FunPtr (FunPtr (CInt -> CInt -> IO CInt) -> __exported by:__ @manual\/function_pointers.h@ -} apply2_ptr = unsafePerformIO hs_bindgen_1bf5d46d7038cf34 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_95e560983f86bd1d" hs_bindgen_95e560983f86bd1d_base :: BaseForeignType (IO (FunPtr (FunPtr Int2int -> + CInt -> + IO CInt))) {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_pointer_arg_ptr@ -} -foreign import ccall safe "hs_bindgen_95e560983f86bd1d" hs_bindgen_95e560983f86bd1d :: IO (FunPtr (FunPtr Int2int -> - CInt -> - IO CInt)) +hs_bindgen_95e560983f86bd1d :: IO (FunPtr (FunPtr Int2int -> + CInt -> IO CInt)) +{-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_pointer_arg_ptr@ +-} +hs_bindgen_95e560983f86bd1d = fromBaseForeignType hs_bindgen_95e560983f86bd1d_base {-# NOINLINE apply1_pointer_arg_ptr #-} {-| Basically the same as apply1(), but here for illustratory purposes. @@ -622,11 +856,18 @@ __defined at:__ @manual\/function_pointers.h:22:12@ __exported by:__ @manual\/function_pointers.h@ -} apply1_pointer_arg_ptr = unsafePerformIO hs_bindgen_95e560983f86bd1d +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_9738799dd67af2e9" hs_bindgen_9738799dd67af2e9_base :: BaseForeignType (IO (FunPtr (FunPtr Int2int -> + CInt -> + IO CInt))) {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_nopointer_arg_ptr@ -} -foreign import ccall safe "hs_bindgen_9738799dd67af2e9" hs_bindgen_9738799dd67af2e9 :: IO (FunPtr (FunPtr Int2int -> - CInt -> - IO CInt)) +hs_bindgen_9738799dd67af2e9 :: IO (FunPtr (FunPtr Int2int -> + CInt -> IO CInt)) +{-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_nopointer_arg_ptr@ +-} +hs_bindgen_9738799dd67af2e9 = fromBaseForeignType hs_bindgen_9738799dd67af2e9_base {-# NOINLINE apply1_nopointer_arg_ptr #-} {-| A version of apply1_pointer_arg() that declares to take a argument of function type, rather than a pointer-to-function type. @@ -647,11 +888,18 @@ __defined at:__ @manual\/function_pointers.h:26:12@ __exported by:__ @manual\/function_pointers.h@ -} apply1_nopointer_arg_ptr = unsafePerformIO hs_bindgen_9738799dd67af2e9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c9d47a6b0f980aa5" hs_bindgen_c9d47a6b0f980aa5_base :: BaseForeignType (IO (FunPtr (IO (FunPtr (FunPtr Int2int -> + CInt -> + IO CInt))))) +{-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_nopointer_res_ptr@ +-} +hs_bindgen_c9d47a6b0f980aa5 :: IO (FunPtr (IO (FunPtr (FunPtr Int2int -> + CInt -> IO CInt)))) {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_nopointer_res_ptr@ -} -foreign import ccall safe "hs_bindgen_c9d47a6b0f980aa5" hs_bindgen_c9d47a6b0f980aa5 :: IO (FunPtr (IO (FunPtr (FunPtr Int2int -> - CInt -> - IO CInt)))) +hs_bindgen_c9d47a6b0f980aa5 = fromBaseForeignType hs_bindgen_c9d47a6b0f980aa5_base {-# NOINLINE apply1_nopointer_res_ptr #-} {-| A function returning a pointer to a function like apply1_nopointer(). @@ -672,11 +920,18 @@ __defined at:__ @manual\/function_pointers.h:31:21@ __exported by:__ @manual\/function_pointers.h@ -} apply1_nopointer_res_ptr = unsafePerformIO hs_bindgen_c9d47a6b0f980aa5 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ab897ed3a6702a69" hs_bindgen_ab897ed3a6702a69_base :: BaseForeignType (IO (Ptr (FunPtr (FunPtr Int2int -> + CInt -> + IO CInt)))) {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_nopointer_var_ptr@ -} -foreign import ccall safe "hs_bindgen_ab897ed3a6702a69" hs_bindgen_ab897ed3a6702a69 :: IO (Ptr (FunPtr (FunPtr Int2int -> - CInt -> - IO CInt))) +hs_bindgen_ab897ed3a6702a69 :: IO (Ptr (FunPtr (FunPtr Int2int -> + CInt -> IO CInt))) +{-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_nopointer_var_ptr@ +-} +hs_bindgen_ab897ed3a6702a69 = fromBaseForeignType hs_bindgen_ab897ed3a6702a69_base {-# NOINLINE apply1_nopointer_var_ptr #-} {-| A global variable pointing to a function like apply1_nopointer(). @@ -700,9 +955,15 @@ apply1_nopointer_var_ptr = unsafePerformIO hs_bindgen_ab897ed3a6702a69 {-# NOINLINE apply1_nopointer_var #-} apply1_nopointer_var :: FunPtr (FunPtr Int2int -> CInt -> IO CInt) apply1_nopointer_var = unsafePerformIO (peek apply1_nopointer_var_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_448bdc6115d5924e" hs_bindgen_448bdc6115d5924e_base :: BaseForeignType (IO (Ptr Apply1Struct)) {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_struct_ptr@ -} -foreign import ccall safe "hs_bindgen_448bdc6115d5924e" hs_bindgen_448bdc6115d5924e :: IO (Ptr Apply1Struct) +hs_bindgen_448bdc6115d5924e :: IO (Ptr Apply1Struct) +{-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_struct_ptr@ +-} +hs_bindgen_448bdc6115d5924e = fromBaseForeignType hs_bindgen_448bdc6115d5924e_base {-# NOINLINE apply1_struct_ptr #-} {-| __C declaration:__ @apply1_struct@ @@ -721,9 +982,15 @@ apply1_struct_ptr = unsafePerformIO hs_bindgen_448bdc6115d5924e {-# NOINLINE apply1_struct #-} apply1_struct :: Apply1Struct apply1_struct = unsafePerformIO (peek apply1_struct_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3f47656e6bb54e94" hs_bindgen_3f47656e6bb54e94_base :: BaseForeignType (IO (Ptr Apply1Union)) +{-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_union_ptr@ +-} +hs_bindgen_3f47656e6bb54e94 :: IO (Ptr Apply1Union) {-| __unique:__ @test_manualfunction_pointers_Example_get_apply1_union_ptr@ -} -foreign import ccall safe "hs_bindgen_3f47656e6bb54e94" hs_bindgen_3f47656e6bb54e94 :: IO (Ptr Apply1Union) +hs_bindgen_3f47656e6bb54e94 = fromBaseForeignType hs_bindgen_3f47656e6bb54e94_base {-# NOINLINE apply1_union_ptr #-} {-| __C declaration:__ @apply1_union@ diff --git a/hs-bindgen/fixtures/manual/zero_copy/Example/FunPtr.hs b/hs-bindgen/fixtures/manual/zero_copy/Example/FunPtr.hs index e107e7458..9a2353d93 100644 --- a/hs-bindgen/fixtures/manual/zero_copy/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/manual/zero_copy/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -34,10 +35,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_d76d6b95b7803c78" hs_bindgen_d76d6b95b7803c78_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr Vector) -> (Ptr.Ptr Vector) -> IO FC.CInt))) + {-| __unique:__ @test_manualzero_copy_Example_get_reverse_ptr@ -} -foreign import ccall unsafe "hs_bindgen_d76d6b95b7803c78" hs_bindgen_d76d6b95b7803c78 :: +hs_bindgen_d76d6b95b7803c78 :: IO (Ptr.FunPtr ((Ptr.Ptr Vector) -> (Ptr.Ptr Vector) -> IO FC.CInt)) +hs_bindgen_d76d6b95b7803c78 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_d76d6b95b7803c78_base {-# NOINLINE reverse_ptr #-} @@ -51,10 +59,17 @@ reverse_ptr :: Ptr.FunPtr ((Ptr.Ptr Vector) -> (Ptr.Ptr Vector) -> IO FC.CInt) reverse_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_d76d6b95b7803c78 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f72c56033fb58d5e" hs_bindgen_f72c56033fb58d5e_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Matrix -> Matrix -> IO ()))) + {-| __unique:__ @test_manualzero_copy_Example_get_transpose_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f72c56033fb58d5e" hs_bindgen_f72c56033fb58d5e :: +hs_bindgen_f72c56033fb58d5e :: IO (Ptr.FunPtr (Matrix -> Matrix -> IO ())) +hs_bindgen_f72c56033fb58d5e = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f72c56033fb58d5e_base {-# NOINLINE transpose_ptr #-} diff --git a/hs-bindgen/fixtures/manual/zero_copy/Example/Safe.hs b/hs-bindgen/fixtures/manual/zero_copy/Example/Safe.hs index d04291313..f6cb6a0f9 100644 --- a/hs-bindgen/fixtures/manual/zero_copy/Example/Safe.hs +++ b/hs-bindgen/fixtures/manual/zero_copy/Example/Safe.hs @@ -8,6 +8,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -30,6 +31,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_350cceac1101d344" reverse_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Vector) -> (Ptr.Ptr Vector) -> IO FC.CInt) + {-| __C declaration:__ @reverse@ __defined at:__ @manual\/zero_copy.h:77:5@ @@ -38,7 +44,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_manualzero_copy_Example_Safe_reverse@ -} -foreign import ccall safe "hs_bindgen_350cceac1101d344" reverse :: +reverse :: Ptr.Ptr Vector {- ^ __C declaration:__ @input@ -} @@ -46,15 +52,24 @@ foreign import ccall safe "hs_bindgen_350cceac1101d344" reverse :: {- ^ __C declaration:__ @output@ -} -> IO FC.CInt +reverse = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType reverse_base + +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2ff371c815d92b04" transpose_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Triplet) -> (Ptr.Ptr Triplet) -> IO ()) {-| Pointer-based API for 'transpose' __unique:__ @test_manualzero_copy_Example_Safe_transpose@ -} -foreign import ccall safe "hs_bindgen_2ff371c815d92b04" transpose_wrapper :: +transpose_wrapper :: Ptr.Ptr Triplet -> Ptr.Ptr Triplet -> IO () +transpose_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType transpose_wrapper_base {-| __C declaration:__ @transpose@ diff --git a/hs-bindgen/fixtures/manual/zero_copy/Example/Unsafe.hs b/hs-bindgen/fixtures/manual/zero_copy/Example/Unsafe.hs index 4d8891ef3..a9c5a7ad9 100644 --- a/hs-bindgen/fixtures/manual/zero_copy/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/manual/zero_copy/Example/Unsafe.hs @@ -8,6 +8,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -30,6 +31,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f9655173d51bbaac" reverse_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Vector) -> (Ptr.Ptr Vector) -> IO FC.CInt) + {-| __C declaration:__ @reverse@ __defined at:__ @manual\/zero_copy.h:77:5@ @@ -38,7 +44,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_manualzero_copy_Example_Unsafe_reverse@ -} -foreign import ccall unsafe "hs_bindgen_f9655173d51bbaac" reverse :: +reverse :: Ptr.Ptr Vector {- ^ __C declaration:__ @input@ -} @@ -46,15 +52,24 @@ foreign import ccall unsafe "hs_bindgen_f9655173d51bbaac" reverse :: {- ^ __C declaration:__ @output@ -} -> IO FC.CInt +reverse = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType reverse_base + +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ea25667627dd5ed2" transpose_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Triplet) -> (Ptr.Ptr Triplet) -> IO ()) {-| Pointer-based API for 'transpose' __unique:__ @test_manualzero_copy_Example_Unsafe_transpose@ -} -foreign import ccall unsafe "hs_bindgen_ea25667627dd5ed2" transpose_wrapper :: +transpose_wrapper :: Ptr.Ptr Triplet -> Ptr.Ptr Triplet -> IO () +transpose_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType transpose_wrapper_base {-| __C declaration:__ @transpose@ diff --git a/hs-bindgen/fixtures/manual/zero_copy/th.txt b/hs-bindgen/fixtures/manual/zero_copy/th.txt index b4be9925f..d0752da11 100644 --- a/hs-bindgen/fixtures/manual/zero_copy/th.txt +++ b/hs-bindgen/fixtures/manual/zero_copy/th.txt @@ -610,6 +610,20 @@ instance TyEq ty (CFieldType Matrix "un_Matrix") => instance HasCField Matrix "un_Matrix" where type CFieldType Matrix "un_Matrix" = ConstantArray 3 Triplet offset# = \_ -> \_ -> 0 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_350cceac1101d344" reverse_base :: BaseForeignType (Ptr Vector -> + Ptr Vector -> + IO CInt) +{-| __C declaration:__ @reverse@ + + __defined at:__ @manual\/zero_copy.h:77:5@ + + __exported by:__ @manual\/zero_copy.h@ + + __unique:__ @test_manualzero_copy_Example_Unsafe_reverse@ +-} +reverse :: Ptr Vector -> Ptr Vector -> IO CInt {-| __C declaration:__ @reverse@ __defined at:__ @manual\/zero_copy.h:77:5@ @@ -618,14 +632,22 @@ instance HasCField Matrix "un_Matrix" __unique:__ @test_manualzero_copy_Example_Unsafe_reverse@ -} -foreign import ccall safe "hs_bindgen_350cceac1101d344" reverse :: Ptr Vector -> - Ptr Vector -> IO CInt +reverse = fromBaseForeignType reverse_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_2ff371c815d92b04" transpose_wrapper_base :: BaseForeignType (Ptr Triplet -> + Ptr Triplet -> + IO Unit) +{-| Pointer-based API for 'transpose' + +__unique:__ @test_manualzero_copy_Example_Unsafe_transpose@ +-} +transpose_wrapper :: Ptr Triplet -> Ptr Triplet -> IO Unit {-| Pointer-based API for 'transpose' __unique:__ @test_manualzero_copy_Example_Unsafe_transpose@ -} -foreign import ccall safe "hs_bindgen_2ff371c815d92b04" transpose_wrapper :: Ptr Triplet -> - Ptr Triplet -> IO Unit +transpose_wrapper = fromBaseForeignType transpose_wrapper_base {-| __C declaration:__ @transpose@ __defined at:__ @manual\/zero_copy.h:85:6@ @@ -640,6 +662,20 @@ transpose :: Matrix -> Ptr Triplet -> IO Unit __exported by:__ @manual\/zero_copy.h@ -} transpose = \x_0 -> \x_1 -> withPtr x_0 (\ptr_2 -> transpose_wrapper ptr_2 x_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f9655173d51bbaac" reverse_base :: BaseForeignType (Ptr Vector -> + Ptr Vector -> + IO CInt) +{-| __C declaration:__ @reverse@ + + __defined at:__ @manual\/zero_copy.h:77:5@ + + __exported by:__ @manual\/zero_copy.h@ + + __unique:__ @test_manualzero_copy_Example_Unsafe_reverse@ +-} +reverse :: Ptr Vector -> Ptr Vector -> IO CInt {-| __C declaration:__ @reverse@ __defined at:__ @manual\/zero_copy.h:77:5@ @@ -648,14 +684,22 @@ transpose = \x_0 -> \x_1 -> withPtr x_0 (\ptr_2 -> transpose_wrapper ptr_2 x_1) __unique:__ @test_manualzero_copy_Example_Unsafe_reverse@ -} -foreign import ccall safe "hs_bindgen_f9655173d51bbaac" reverse :: Ptr Vector -> - Ptr Vector -> IO CInt +reverse = fromBaseForeignType reverse_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ea25667627dd5ed2" transpose_wrapper_base :: BaseForeignType (Ptr Triplet -> + Ptr Triplet -> + IO Unit) {-| Pointer-based API for 'transpose' __unique:__ @test_manualzero_copy_Example_Unsafe_transpose@ -} -foreign import ccall safe "hs_bindgen_ea25667627dd5ed2" transpose_wrapper :: Ptr Triplet -> - Ptr Triplet -> IO Unit +transpose_wrapper :: Ptr Triplet -> Ptr Triplet -> IO Unit +{-| Pointer-based API for 'transpose' + +__unique:__ @test_manualzero_copy_Example_Unsafe_transpose@ +-} +transpose_wrapper = fromBaseForeignType transpose_wrapper_base {-| __C declaration:__ @transpose@ __defined at:__ @manual\/zero_copy.h:85:6@ @@ -670,11 +714,18 @@ transpose :: Matrix -> Ptr Triplet -> IO Unit __exported by:__ @manual\/zero_copy.h@ -} transpose = \x_0 -> \x_1 -> withPtr x_0 (\ptr_2 -> transpose_wrapper ptr_2 x_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_d76d6b95b7803c78" hs_bindgen_d76d6b95b7803c78_base :: BaseForeignType (IO (FunPtr (Ptr Vector -> + Ptr Vector -> + IO CInt))) +{-| __unique:__ @test_manualzero_copy_Example_get_reverse_ptr@ +-} +hs_bindgen_d76d6b95b7803c78 :: IO (FunPtr (Ptr Vector -> + Ptr Vector -> IO CInt)) {-| __unique:__ @test_manualzero_copy_Example_get_reverse_ptr@ -} -foreign import ccall safe "hs_bindgen_d76d6b95b7803c78" hs_bindgen_d76d6b95b7803c78 :: IO (FunPtr (Ptr Vector -> - Ptr Vector -> - IO CInt)) +hs_bindgen_d76d6b95b7803c78 = fromBaseForeignType hs_bindgen_d76d6b95b7803c78_base {-# NOINLINE reverse_ptr #-} {-| __C declaration:__ @reverse@ @@ -690,11 +741,18 @@ reverse_ptr :: FunPtr (Ptr Vector -> Ptr Vector -> IO CInt) __exported by:__ @manual\/zero_copy.h@ -} reverse_ptr = unsafePerformIO hs_bindgen_d76d6b95b7803c78 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f72c56033fb58d5e" hs_bindgen_f72c56033fb58d5e_base :: BaseForeignType (IO (FunPtr (Matrix -> + Matrix -> + IO Unit))) +{-| __unique:__ @test_manualzero_copy_Example_get_transpose_ptr@ +-} +hs_bindgen_f72c56033fb58d5e :: IO (FunPtr (Matrix -> + Matrix -> IO Unit)) {-| __unique:__ @test_manualzero_copy_Example_get_transpose_ptr@ -} -foreign import ccall safe "hs_bindgen_f72c56033fb58d5e" hs_bindgen_f72c56033fb58d5e :: IO (FunPtr (Matrix -> - Matrix -> - IO Unit)) +hs_bindgen_f72c56033fb58d5e = fromBaseForeignType hs_bindgen_f72c56033fb58d5e_base {-# NOINLINE transpose_ptr #-} {-| __C declaration:__ @transpose@ diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/FunPtr.hs b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/FunPtr.hs index 3bf2b7e33..05fa97069 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/FunPtr.hs @@ -7,6 +7,7 @@ module Example.FunPtr where import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) import Example @@ -26,10 +27,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_166bda29e26e15f7" hs_bindgen_166bda29e26e15f7_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr HsBindgen.Runtime.Prelude.CFile) -> (Ptr.Ptr Void) -> HsBindgen.Runtime.Prelude.CSize -> IO FileOperationStatus))) + {-| __unique:__ @test_programanalysisprogram_slici_Example_get_read_file_chunk_ptr@ -} -foreign import ccall unsafe "hs_bindgen_166bda29e26e15f7" hs_bindgen_166bda29e26e15f7 :: +hs_bindgen_166bda29e26e15f7 :: IO (Ptr.FunPtr ((Ptr.Ptr HsBindgen.Runtime.Prelude.CFile) -> (Ptr.Ptr Void) -> HsBindgen.Runtime.Prelude.CSize -> IO FileOperationStatus)) +hs_bindgen_166bda29e26e15f7 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_166bda29e26e15f7_base {-# NOINLINE read_file_chunk_ptr #-} diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/Safe.hs b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/Safe.hs index 172402119..0c0516a7e 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/Safe.hs +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/Safe.hs @@ -6,6 +6,7 @@ module Example.Safe where import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) import Example @@ -23,6 +24,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b2a91b3b7edf2ad3" read_file_chunk_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr HsBindgen.Runtime.Prelude.CFile) -> (Ptr.Ptr Void) -> HsBindgen.Runtime.Prelude.CSize -> IO FileOperationStatus) + {-| __C declaration:__ @read_file_chunk@ __defined at:__ @program-analysis\/program_slicing_selection.h:21:26@ @@ -31,7 +37,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_programanalysisprogram_slici_Example_Safe_read_file_chunk@ -} -foreign import ccall safe "hs_bindgen_b2a91b3b7edf2ad3" read_file_chunk :: +read_file_chunk :: Ptr.Ptr HsBindgen.Runtime.Prelude.CFile {- ^ __C declaration:__ @file_ptr@ -} @@ -42,3 +48,5 @@ foreign import ccall safe "hs_bindgen_b2a91b3b7edf2ad3" read_file_chunk :: {- ^ __C declaration:__ @bytes_to_read@ -} -> IO FileOperationStatus +read_file_chunk = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType read_file_chunk_base diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/Unsafe.hs b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/Unsafe.hs index 5133af74e..bcb058469 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/Example/Unsafe.hs @@ -6,6 +6,7 @@ module Example.Unsafe where import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Data.Void (Void) import Example @@ -23,6 +24,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_654858ed6a5db417" read_file_chunk_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr HsBindgen.Runtime.Prelude.CFile) -> (Ptr.Ptr Void) -> HsBindgen.Runtime.Prelude.CSize -> IO FileOperationStatus) + {-| __C declaration:__ @read_file_chunk@ __defined at:__ @program-analysis\/program_slicing_selection.h:21:26@ @@ -31,7 +37,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_programanalysisprogram_slici_Example_Unsafe_read_file_chunk@ -} -foreign import ccall unsafe "hs_bindgen_654858ed6a5db417" read_file_chunk :: +read_file_chunk :: Ptr.Ptr HsBindgen.Runtime.Prelude.CFile {- ^ __C declaration:__ @file_ptr@ -} @@ -42,3 +48,5 @@ foreign import ccall unsafe "hs_bindgen_654858ed6a5db417" read_file_chunk :: {- ^ __C declaration:__ @bytes_to_read@ -} -> IO FileOperationStatus +read_file_chunk = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType read_file_chunk_base diff --git a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/th.txt b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/th.txt index 6e94578f6..5325d2ac1 100644 --- a/hs-bindgen/fixtures/program-analysis/program_slicing_selection/th.txt +++ b/hs-bindgen/fixtures/program-analysis/program_slicing_selection/th.txt @@ -217,6 +217,12 @@ instance TyEq ty (Ptr FileOperationRecord) (Ptr ty) where getField = ptrToCField (Proxy @"fileOperationRecord_bytes_processed") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b2a91b3b7edf2ad3" read_file_chunk_base :: BaseForeignType (Ptr HsBindgen.Runtime.Prelude.CFile -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> + IO FileOperationStatus) {-| __C declaration:__ @read_file_chunk@ __defined at:__ @program-analysis\/program_slicing_selection.h:21:26@ @@ -225,10 +231,9 @@ instance TyEq ty __unique:__ @test_programanalysisprogram_slici_Example_Unsafe_read_file_chunk@ -} -foreign import ccall safe "hs_bindgen_b2a91b3b7edf2ad3" read_file_chunk :: Ptr HsBindgen.Runtime.Prelude.CFile -> - Ptr Void -> - HsBindgen.Runtime.Prelude.CSize -> - IO FileOperationStatus +read_file_chunk :: Ptr HsBindgen.Runtime.Prelude.CFile -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> IO FileOperationStatus {-| __C declaration:__ @read_file_chunk@ __defined at:__ @program-analysis\/program_slicing_selection.h:21:26@ @@ -237,16 +242,48 @@ foreign import ccall safe "hs_bindgen_b2a91b3b7edf2ad3" read_file_chunk :: Ptr H __unique:__ @test_programanalysisprogram_slici_Example_Unsafe_read_file_chunk@ -} -foreign import ccall safe "hs_bindgen_654858ed6a5db417" read_file_chunk :: Ptr HsBindgen.Runtime.Prelude.CFile -> - Ptr Void -> - HsBindgen.Runtime.Prelude.CSize -> - IO FileOperationStatus +read_file_chunk = fromBaseForeignType read_file_chunk_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_654858ed6a5db417" read_file_chunk_base :: BaseForeignType (Ptr HsBindgen.Runtime.Prelude.CFile -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> + IO FileOperationStatus) +{-| __C declaration:__ @read_file_chunk@ + + __defined at:__ @program-analysis\/program_slicing_selection.h:21:26@ + + __exported by:__ @program-analysis\/program_slicing_selection.h@ + + __unique:__ @test_programanalysisprogram_slici_Example_Unsafe_read_file_chunk@ +-} +read_file_chunk :: Ptr HsBindgen.Runtime.Prelude.CFile -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> IO FileOperationStatus +{-| __C declaration:__ @read_file_chunk@ + + __defined at:__ @program-analysis\/program_slicing_selection.h:21:26@ + + __exported by:__ @program-analysis\/program_slicing_selection.h@ + + __unique:__ @test_programanalysisprogram_slici_Example_Unsafe_read_file_chunk@ +-} +read_file_chunk = fromBaseForeignType read_file_chunk_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_166bda29e26e15f7" hs_bindgen_166bda29e26e15f7_base :: BaseForeignType (IO (FunPtr (Ptr HsBindgen.Runtime.Prelude.CFile -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> + IO FileOperationStatus))) +{-| __unique:__ @test_programanalysisprogram_slici_Example_get_read_file_chunk_ptr@ +-} +hs_bindgen_166bda29e26e15f7 :: IO (FunPtr (Ptr HsBindgen.Runtime.Prelude.CFile -> + Ptr Void -> + HsBindgen.Runtime.Prelude.CSize -> + IO FileOperationStatus)) {-| __unique:__ @test_programanalysisprogram_slici_Example_get_read_file_chunk_ptr@ -} -foreign import ccall safe "hs_bindgen_166bda29e26e15f7" hs_bindgen_166bda29e26e15f7 :: IO (FunPtr (Ptr HsBindgen.Runtime.Prelude.CFile -> - Ptr Void -> - HsBindgen.Runtime.Prelude.CSize -> - IO FileOperationStatus)) +hs_bindgen_166bda29e26e15f7 = fromBaseForeignType hs_bindgen_166bda29e26e15f7_base {-# NOINLINE read_file_chunk_ptr #-} {-| __C declaration:__ @read_file_chunk@ diff --git a/hs-bindgen/fixtures/types/complex/complex_non_float_test/Example/Global.hs b/hs-bindgen/fixtures/types/complex/complex_non_float_test/Example/Global.hs index 56fdf4fe4..b1f6aa821 100644 --- a/hs-bindgen/fixtures/types/complex/complex_non_float_test/Example/Global.hs +++ b/hs-bindgen/fixtures/types/complex/complex_non_float_test/Example/Global.hs @@ -9,6 +9,7 @@ import qualified Data.Complex import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -46,10 +47,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f06a1feab15d0572" hs_bindgen_f06a1feab15d0572_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CUShort))) + {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_unsigned_short_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f06a1feab15d0572" hs_bindgen_f06a1feab15d0572 :: +hs_bindgen_f06a1feab15d0572 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CUShort)) +hs_bindgen_f06a1feab15d0572 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f06a1feab15d0572_base {-# NOINLINE global_complex_unsigned_short_ptr #-} @@ -63,10 +71,17 @@ global_complex_unsigned_short_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CUShort) global_complex_unsigned_short_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f06a1feab15d0572 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_96f1e350c6c42760" hs_bindgen_96f1e350c6c42760_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CShort))) + {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_short_ptr@ -} -foreign import ccall unsafe "hs_bindgen_96f1e350c6c42760" hs_bindgen_96f1e350c6c42760 :: +hs_bindgen_96f1e350c6c42760 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CShort)) +hs_bindgen_96f1e350c6c42760 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_96f1e350c6c42760_base {-# NOINLINE global_complex_short_ptr #-} @@ -80,10 +95,17 @@ global_complex_short_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CShort) global_complex_short_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_96f1e350c6c42760 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_f11054676f537692" hs_bindgen_f11054676f537692_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CUInt))) + {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_unsigned_int_ptr@ -} -foreign import ccall unsafe "hs_bindgen_f11054676f537692" hs_bindgen_f11054676f537692 :: +hs_bindgen_f11054676f537692 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CUInt)) +hs_bindgen_f11054676f537692 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_f11054676f537692_base {-# NOINLINE global_complex_unsigned_int_ptr #-} @@ -97,10 +119,17 @@ global_complex_unsigned_int_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CUInt) global_complex_unsigned_int_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_f11054676f537692 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c5a5feb6d6df39b6" hs_bindgen_c5a5feb6d6df39b6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CInt))) + {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_int_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c5a5feb6d6df39b6" hs_bindgen_c5a5feb6d6df39b6 :: +hs_bindgen_c5a5feb6d6df39b6 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CInt)) +hs_bindgen_c5a5feb6d6df39b6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c5a5feb6d6df39b6_base {-# NOINLINE global_complex_int_ptr #-} @@ -114,10 +143,17 @@ global_complex_int_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CInt) global_complex_int_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_c5a5feb6d6df39b6 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4265dc893a126b40" hs_bindgen_4265dc893a126b40_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CChar))) + {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_char_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4265dc893a126b40" hs_bindgen_4265dc893a126b40 :: +hs_bindgen_4265dc893a126b40 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CChar)) +hs_bindgen_4265dc893a126b40 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4265dc893a126b40_base {-# NOINLINE global_complex_char_ptr #-} diff --git a/hs-bindgen/fixtures/types/complex/complex_non_float_test/th.txt b/hs-bindgen/fixtures/types/complex/complex_non_float_test/th.txt index c2b8bf354..6f078f3d5 100644 --- a/hs-bindgen/fixtures/types/complex/complex_non_float_test/th.txt +++ b/hs-bindgen/fixtures/types/complex/complex_non_float_test/th.txt @@ -31,9 +31,15 @@ -- { -- return &global_complex_char; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f06a1feab15d0572" hs_bindgen_f06a1feab15d0572_base :: BaseForeignType (IO (Ptr (Complex CUShort))) +{-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_unsigned_short_ptr@ +-} +hs_bindgen_f06a1feab15d0572 :: IO (Ptr (Complex CUShort)) {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_unsigned_short_ptr@ -} -foreign import ccall safe "hs_bindgen_f06a1feab15d0572" hs_bindgen_f06a1feab15d0572 :: IO (Ptr (Complex CUShort)) +hs_bindgen_f06a1feab15d0572 = fromBaseForeignType hs_bindgen_f06a1feab15d0572_base {-# NOINLINE global_complex_unsigned_short_ptr #-} {-| __C declaration:__ @global_complex_unsigned_short@ @@ -49,9 +55,15 @@ global_complex_unsigned_short_ptr :: Ptr (Complex CUShort) __exported by:__ @types\/complex\/complex_non_float_test.h@ -} global_complex_unsigned_short_ptr = unsafePerformIO hs_bindgen_f06a1feab15d0572 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_96f1e350c6c42760" hs_bindgen_96f1e350c6c42760_base :: BaseForeignType (IO (Ptr (Complex CShort))) {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_short_ptr@ -} -foreign import ccall safe "hs_bindgen_96f1e350c6c42760" hs_bindgen_96f1e350c6c42760 :: IO (Ptr (Complex CShort)) +hs_bindgen_96f1e350c6c42760 :: IO (Ptr (Complex CShort)) +{-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_short_ptr@ +-} +hs_bindgen_96f1e350c6c42760 = fromBaseForeignType hs_bindgen_96f1e350c6c42760_base {-# NOINLINE global_complex_short_ptr #-} {-| __C declaration:__ @global_complex_short@ @@ -67,9 +79,15 @@ global_complex_short_ptr :: Ptr (Complex CShort) __exported by:__ @types\/complex\/complex_non_float_test.h@ -} global_complex_short_ptr = unsafePerformIO hs_bindgen_96f1e350c6c42760 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_f11054676f537692" hs_bindgen_f11054676f537692_base :: BaseForeignType (IO (Ptr (Complex CUInt))) {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_unsigned_int_ptr@ -} -foreign import ccall safe "hs_bindgen_f11054676f537692" hs_bindgen_f11054676f537692 :: IO (Ptr (Complex CUInt)) +hs_bindgen_f11054676f537692 :: IO (Ptr (Complex CUInt)) +{-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_unsigned_int_ptr@ +-} +hs_bindgen_f11054676f537692 = fromBaseForeignType hs_bindgen_f11054676f537692_base {-# NOINLINE global_complex_unsigned_int_ptr #-} {-| __C declaration:__ @global_complex_unsigned_int@ @@ -85,9 +103,15 @@ global_complex_unsigned_int_ptr :: Ptr (Complex CUInt) __exported by:__ @types\/complex\/complex_non_float_test.h@ -} global_complex_unsigned_int_ptr = unsafePerformIO hs_bindgen_f11054676f537692 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c5a5feb6d6df39b6" hs_bindgen_c5a5feb6d6df39b6_base :: BaseForeignType (IO (Ptr (Complex CInt))) +{-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_int_ptr@ +-} +hs_bindgen_c5a5feb6d6df39b6 :: IO (Ptr (Complex CInt)) {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_int_ptr@ -} -foreign import ccall safe "hs_bindgen_c5a5feb6d6df39b6" hs_bindgen_c5a5feb6d6df39b6 :: IO (Ptr (Complex CInt)) +hs_bindgen_c5a5feb6d6df39b6 = fromBaseForeignType hs_bindgen_c5a5feb6d6df39b6_base {-# NOINLINE global_complex_int_ptr #-} {-| __C declaration:__ @global_complex_int@ @@ -103,9 +127,15 @@ global_complex_int_ptr :: Ptr (Complex CInt) __exported by:__ @types\/complex\/complex_non_float_test.h@ -} global_complex_int_ptr = unsafePerformIO hs_bindgen_c5a5feb6d6df39b6 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4265dc893a126b40" hs_bindgen_4265dc893a126b40_base :: BaseForeignType (IO (Ptr (Complex CChar))) +{-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_char_ptr@ +-} +hs_bindgen_4265dc893a126b40 :: IO (Ptr (Complex CChar)) {-| __unique:__ @test_typescomplexcomplex_non_floa_Example_get_global_complex_char_ptr@ -} -foreign import ccall safe "hs_bindgen_4265dc893a126b40" hs_bindgen_4265dc893a126b40 :: IO (Ptr (Complex CChar)) +hs_bindgen_4265dc893a126b40 = fromBaseForeignType hs_bindgen_4265dc893a126b40_base {-# NOINLINE global_complex_char_ptr #-} {-| __C declaration:__ @global_complex_char@ diff --git a/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/FunPtr.hs b/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/FunPtr.hs index 9065ae438..3a5237dd4 100644 --- a/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/FunPtr.hs @@ -9,6 +9,7 @@ import qualified Data.Complex import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -34,10 +35,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8c8d85daac0162fd" hs_bindgen_8c8d85daac0162fd_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Data.Complex.Complex FC.CFloat) -> (Data.Complex.Complex FC.CFloat) -> IO (Data.Complex.Complex FC.CFloat)))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_multiply_complex_f_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8c8d85daac0162fd" hs_bindgen_8c8d85daac0162fd :: +hs_bindgen_8c8d85daac0162fd :: IO (Ptr.FunPtr ((Data.Complex.Complex FC.CFloat) -> (Data.Complex.Complex FC.CFloat) -> IO (Data.Complex.Complex FC.CFloat))) +hs_bindgen_8c8d85daac0162fd = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8c8d85daac0162fd_base {-# NOINLINE multiply_complex_f_ptr #-} @@ -51,10 +59,17 @@ multiply_complex_f_ptr :: Ptr.FunPtr ((Data.Complex.Complex FC.CFloat) -> (Data. multiply_complex_f_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_8c8d85daac0162fd +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_656a87248425c79a" hs_bindgen_656a87248425c79a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Data.Complex.Complex FC.CDouble) -> (Data.Complex.Complex FC.CDouble) -> IO (Data.Complex.Complex FC.CDouble)))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_add_complex_ptr@ -} -foreign import ccall unsafe "hs_bindgen_656a87248425c79a" hs_bindgen_656a87248425c79a :: +hs_bindgen_656a87248425c79a :: IO (Ptr.FunPtr ((Data.Complex.Complex FC.CDouble) -> (Data.Complex.Complex FC.CDouble) -> IO (Data.Complex.Complex FC.CDouble))) +hs_bindgen_656a87248425c79a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_656a87248425c79a_base {-# NOINLINE add_complex_ptr #-} diff --git a/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Global.hs b/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Global.hs index 18cb58bf5..b5f8b55f6 100644 --- a/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Global.hs +++ b/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Global.hs @@ -12,6 +12,7 @@ import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.ConstantArray +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -103,10 +104,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a6dcbf0ebef057c9" hs_bindgen_a6dcbf0ebef057c9_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_float_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a6dcbf0ebef057c9" hs_bindgen_a6dcbf0ebef057c9 :: +hs_bindgen_a6dcbf0ebef057c9 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) +hs_bindgen_a6dcbf0ebef057c9 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a6dcbf0ebef057c9_base {-# NOINLINE global_complex_float_ptr #-} @@ -120,10 +128,17 @@ global_complex_float_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CFloat) global_complex_float_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_a6dcbf0ebef057c9 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_6102571a73986812" hs_bindgen_6102571a73986812_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_double_ptr@ -} -foreign import ccall unsafe "hs_bindgen_6102571a73986812" hs_bindgen_6102571a73986812 :: +hs_bindgen_6102571a73986812 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) +hs_bindgen_6102571a73986812 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_6102571a73986812_base {-# NOINLINE global_complex_double_ptr #-} @@ -137,10 +152,17 @@ global_complex_double_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CDouble) global_complex_double_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_6102571a73986812 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1b0a02397e2ea2f6" hs_bindgen_1b0a02397e2ea2f6_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_float_flipped_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1b0a02397e2ea2f6" hs_bindgen_1b0a02397e2ea2f6 :: +hs_bindgen_1b0a02397e2ea2f6 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) +hs_bindgen_1b0a02397e2ea2f6 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1b0a02397e2ea2f6_base {-# NOINLINE global_complex_float_flipped_ptr #-} @@ -154,10 +176,17 @@ global_complex_float_flipped_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CFloat) global_complex_float_flipped_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_1b0a02397e2ea2f6 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_4be2464f88314410" hs_bindgen_4be2464f88314410_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_double_flipped_ptr@ -} -foreign import ccall unsafe "hs_bindgen_4be2464f88314410" hs_bindgen_4be2464f88314410 :: +hs_bindgen_4be2464f88314410 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) +hs_bindgen_4be2464f88314410 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_4be2464f88314410_base {-# NOINLINE global_complex_double_flipped_ptr #-} @@ -171,10 +200,17 @@ global_complex_double_flipped_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CDouble) global_complex_double_flipped_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_4be2464f88314410 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_aa07323f7398ff97" hs_bindgen_aa07323f7398ff97_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_float_ptr@ -} -foreign import ccall unsafe "hs_bindgen_aa07323f7398ff97" hs_bindgen_aa07323f7398ff97 :: +hs_bindgen_aa07323f7398ff97 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) +hs_bindgen_aa07323f7398ff97 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_aa07323f7398ff97_base {-# NOINLINE global_Complex_float_ptr #-} @@ -188,10 +224,17 @@ global_Complex_float_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CFloat) global_Complex_float_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_aa07323f7398ff97 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_190b07a847b36556" hs_bindgen_190b07a847b36556_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_double_ptr@ -} -foreign import ccall unsafe "hs_bindgen_190b07a847b36556" hs_bindgen_190b07a847b36556 :: +hs_bindgen_190b07a847b36556 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) +hs_bindgen_190b07a847b36556 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_190b07a847b36556_base {-# NOINLINE global_Complex_double_ptr #-} @@ -205,10 +248,17 @@ global_Complex_double_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CDouble) global_Complex_double_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_190b07a847b36556 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_017435f1022a672c" hs_bindgen_017435f1022a672c_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_float_flipped_ptr@ -} -foreign import ccall unsafe "hs_bindgen_017435f1022a672c" hs_bindgen_017435f1022a672c :: +hs_bindgen_017435f1022a672c :: IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) +hs_bindgen_017435f1022a672c = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_017435f1022a672c_base {-# NOINLINE global_Complex_float_flipped_ptr #-} @@ -222,10 +272,17 @@ global_Complex_float_flipped_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CFloat) global_Complex_float_flipped_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_017435f1022a672c +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_aec6991fbd3ffdbb" hs_bindgen_aec6991fbd3ffdbb_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_double_flipped_ptr@ -} -foreign import ccall unsafe "hs_bindgen_aec6991fbd3ffdbb" hs_bindgen_aec6991fbd3ffdbb :: +hs_bindgen_aec6991fbd3ffdbb :: IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) +hs_bindgen_aec6991fbd3ffdbb = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_aec6991fbd3ffdbb_base {-# NOINLINE global_Complex_double_flipped_ptr #-} @@ -239,10 +296,17 @@ global_Complex_double_flipped_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CDouble) global_Complex_double_flipped_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_aec6991fbd3ffdbb +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_3ea97dc5fdb27263" hs_bindgen_3ea97dc5fdb27263_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_const_complex_float_ptr@ -} -foreign import ccall unsafe "hs_bindgen_3ea97dc5fdb27263" hs_bindgen_3ea97dc5fdb27263 :: +hs_bindgen_3ea97dc5fdb27263 :: IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) +hs_bindgen_3ea97dc5fdb27263 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_3ea97dc5fdb27263_base {-# NOINLINE const_complex_float_ptr #-} @@ -262,10 +326,17 @@ const_complex_float :: Data.Complex.Complex FC.CFloat const_complex_float = GHC.IO.Unsafe.unsafePerformIO (F.peek const_complex_float_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_086209fa0eb9a3ee" hs_bindgen_086209fa0eb9a3ee_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_const_complex_double_ptr@ -} -foreign import ccall unsafe "hs_bindgen_086209fa0eb9a3ee" hs_bindgen_086209fa0eb9a3ee :: +hs_bindgen_086209fa0eb9a3ee :: IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) +hs_bindgen_086209fa0eb9a3ee = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_086209fa0eb9a3ee_base {-# NOINLINE const_complex_double_ptr #-} @@ -285,10 +356,17 @@ const_complex_double :: Data.Complex.Complex FC.CDouble const_complex_double = GHC.IO.Unsafe.unsafePerformIO (F.peek const_complex_double_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_00177fb0da38717b" hs_bindgen_00177fb0da38717b_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_volatile_complex_float_ptr@ -} -foreign import ccall unsafe "hs_bindgen_00177fb0da38717b" hs_bindgen_00177fb0da38717b :: +hs_bindgen_00177fb0da38717b :: IO (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) +hs_bindgen_00177fb0da38717b = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_00177fb0da38717b_base {-# NOINLINE volatile_complex_float_ptr #-} @@ -302,10 +380,17 @@ volatile_complex_float_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CFloat) volatile_complex_float_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_00177fb0da38717b +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_72f5727716adf5ac" hs_bindgen_72f5727716adf5ac_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_volatile_complex_double_ptr@ -} -foreign import ccall unsafe "hs_bindgen_72f5727716adf5ac" hs_bindgen_72f5727716adf5ac :: +hs_bindgen_72f5727716adf5ac :: IO (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) +hs_bindgen_72f5727716adf5ac = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_72f5727716adf5ac_base {-# NOINLINE volatile_complex_double_ptr #-} @@ -319,10 +404,17 @@ volatile_complex_double_ptr :: Ptr.Ptr (Data.Complex.Complex FC.CDouble) volatile_complex_double_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_72f5727716adf5ac +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_229c51ee9572efe8" hs_bindgen_229c51ee9572efe8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 10) (Data.Complex.Complex FC.CFloat)))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_complex_float_array_ptr@ -} -foreign import ccall unsafe "hs_bindgen_229c51ee9572efe8" hs_bindgen_229c51ee9572efe8 :: +hs_bindgen_229c51ee9572efe8 :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 10) (Data.Complex.Complex FC.CFloat))) +hs_bindgen_229c51ee9572efe8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_229c51ee9572efe8_base {-# NOINLINE complex_float_array_ptr #-} @@ -336,10 +428,17 @@ complex_float_array_ptr :: Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArr complex_float_array_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_229c51ee9572efe8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_b2b11d22608bbfec" hs_bindgen_b2b11d22608bbfec_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 10) (Data.Complex.Complex FC.CDouble)))) + {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_complex_double_array_ptr@ -} -foreign import ccall unsafe "hs_bindgen_b2b11d22608bbfec" hs_bindgen_b2b11d22608bbfec :: +hs_bindgen_b2b11d22608bbfec :: IO (Ptr.Ptr ((HsBindgen.Runtime.ConstantArray.ConstantArray 10) (Data.Complex.Complex FC.CDouble))) +hs_bindgen_b2b11d22608bbfec = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_b2b11d22608bbfec_base {-# NOINLINE complex_double_array_ptr #-} diff --git a/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Safe.hs b/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Safe.hs index 0de180b63..f450e7c36 100644 --- a/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Safe.hs +++ b/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Safe.hs @@ -10,6 +10,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.CAPI +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -33,15 +34,22 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_687af703c95fba0e" multiply_complex_f_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> IO ()) + {-| Pointer-based API for 'multiply_complex_f' __unique:__ @test_typescomplexhsb_complex_test_Example_Safe_multiply_complex_f@ -} -foreign import ccall safe "hs_bindgen_687af703c95fba0e" multiply_complex_f_wrapper :: +multiply_complex_f_wrapper :: Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> IO () +multiply_complex_f_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType multiply_complex_f_wrapper_base {-| __C declaration:__ @multiply_complex_f@ @@ -65,15 +73,22 @@ multiply_complex_f = HsBindgen.Runtime.CAPI.allocaAndPeek (\z4 -> multiply_complex_f_wrapper y3 y2 z4))) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3ff14ee8c5914fc6" add_complex_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> IO ()) + {-| Pointer-based API for 'add_complex' __unique:__ @test_typescomplexhsb_complex_test_Example_Safe_add_complex@ -} -foreign import ccall safe "hs_bindgen_3ff14ee8c5914fc6" add_complex_wrapper :: +add_complex_wrapper :: Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> IO () +add_complex_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType add_complex_wrapper_base {-| __C declaration:__ @add_complex@ diff --git a/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Unsafe.hs b/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Unsafe.hs index d7e1d74d4..0649ae484 100644 --- a/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/types/complex/hsb_complex_test/Example/Unsafe.hs @@ -10,6 +10,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.CAPI +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -33,15 +34,22 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e5e3172c2163672b" multiply_complex_f_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> (Ptr.Ptr (Data.Complex.Complex FC.CFloat)) -> IO ()) + {-| Pointer-based API for 'multiply_complex_f' __unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_multiply_complex_f@ -} -foreign import ccall unsafe "hs_bindgen_e5e3172c2163672b" multiply_complex_f_wrapper :: +multiply_complex_f_wrapper :: Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> Ptr.Ptr (Data.Complex.Complex FC.CFloat) -> IO () +multiply_complex_f_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType multiply_complex_f_wrapper_base {-| __C declaration:__ @multiply_complex_f@ @@ -65,15 +73,22 @@ multiply_complex_f = HsBindgen.Runtime.CAPI.allocaAndPeek (\z4 -> multiply_complex_f_wrapper y3 y2 z4))) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_28f2705e917973ab" add_complex_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> (Ptr.Ptr (Data.Complex.Complex FC.CDouble)) -> IO ()) + {-| Pointer-based API for 'add_complex' __unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_add_complex@ -} -foreign import ccall unsafe "hs_bindgen_28f2705e917973ab" add_complex_wrapper :: +add_complex_wrapper :: Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> Ptr.Ptr (Data.Complex.Complex FC.CDouble) -> IO () +add_complex_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType add_complex_wrapper_base {-| __C declaration:__ @add_complex@ diff --git a/hs-bindgen/fixtures/types/complex/hsb_complex_test/th.txt b/hs-bindgen/fixtures/types/complex/hsb_complex_test/th.txt index 6a0bbae2e..e65419c98 100644 --- a/hs-bindgen/fixtures/types/complex/hsb_complex_test/th.txt +++ b/hs-bindgen/fixtures/types/complex/hsb_complex_test/th.txt @@ -201,14 +201,23 @@ instance TyEq ty (CFieldType Complex_object_t "complex_object_t_id") => HasField "complex_object_t_id" (Ptr Complex_object_t) (Ptr ty) where getField = ptrToCField (Proxy @"complex_object_t_id") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_687af703c95fba0e" multiply_complex_f_wrapper_base :: BaseForeignType (Ptr (Complex CFloat) -> + Ptr (Complex CFloat) -> + Ptr (Complex CFloat) -> + IO Unit) +{-| Pointer-based API for 'multiply_complex_f' + +__unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_multiply_complex_f@ +-} +multiply_complex_f_wrapper :: Ptr (Complex CFloat) -> + Ptr (Complex CFloat) -> Ptr (Complex CFloat) -> IO Unit {-| Pointer-based API for 'multiply_complex_f' __unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_multiply_complex_f@ -} -foreign import ccall safe "hs_bindgen_687af703c95fba0e" multiply_complex_f_wrapper :: Ptr (Complex CFloat) -> - Ptr (Complex CFloat) -> - Ptr (Complex CFloat) -> - IO Unit +multiply_complex_f_wrapper = fromBaseForeignType multiply_complex_f_wrapper_base {-| __C declaration:__ @multiply_complex_f@ __defined at:__ @types\/complex\/hsb_complex_test.h:21:16@ @@ -224,14 +233,23 @@ multiply_complex_f :: Complex CFloat -> __exported by:__ @types\/complex\/hsb_complex_test.h@ -} multiply_complex_f = \x_0 -> \x_1 -> with x_1 (\y_2 -> with x_0 (\y_3 -> allocaAndPeek (\z_4 -> multiply_complex_f_wrapper y_3 y_2 z_4))) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3ff14ee8c5914fc6" add_complex_wrapper_base :: BaseForeignType (Ptr (Complex CDouble) -> + Ptr (Complex CDouble) -> + Ptr (Complex CDouble) -> + IO Unit) {-| Pointer-based API for 'add_complex' __unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_add_complex@ -} -foreign import ccall safe "hs_bindgen_3ff14ee8c5914fc6" add_complex_wrapper :: Ptr (Complex CDouble) -> - Ptr (Complex CDouble) -> - Ptr (Complex CDouble) -> - IO Unit +add_complex_wrapper :: Ptr (Complex CDouble) -> + Ptr (Complex CDouble) -> Ptr (Complex CDouble) -> IO Unit +{-| Pointer-based API for 'add_complex' + +__unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_add_complex@ +-} +add_complex_wrapper = fromBaseForeignType add_complex_wrapper_base {-| __C declaration:__ @add_complex@ __defined at:__ @types\/complex\/hsb_complex_test.h:22:16@ @@ -247,14 +265,23 @@ add_complex :: Complex CDouble -> __exported by:__ @types\/complex\/hsb_complex_test.h@ -} add_complex = \x_0 -> \x_1 -> with x_1 (\y_2 -> with x_0 (\y_3 -> allocaAndPeek (\z_4 -> add_complex_wrapper y_3 y_2 z_4))) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e5e3172c2163672b" multiply_complex_f_wrapper_base :: BaseForeignType (Ptr (Complex CFloat) -> + Ptr (Complex CFloat) -> + Ptr (Complex CFloat) -> + IO Unit) +{-| Pointer-based API for 'multiply_complex_f' + +__unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_multiply_complex_f@ +-} +multiply_complex_f_wrapper :: Ptr (Complex CFloat) -> + Ptr (Complex CFloat) -> Ptr (Complex CFloat) -> IO Unit {-| Pointer-based API for 'multiply_complex_f' __unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_multiply_complex_f@ -} -foreign import ccall safe "hs_bindgen_e5e3172c2163672b" multiply_complex_f_wrapper :: Ptr (Complex CFloat) -> - Ptr (Complex CFloat) -> - Ptr (Complex CFloat) -> - IO Unit +multiply_complex_f_wrapper = fromBaseForeignType multiply_complex_f_wrapper_base {-| __C declaration:__ @multiply_complex_f@ __defined at:__ @types\/complex\/hsb_complex_test.h:21:16@ @@ -270,14 +297,23 @@ multiply_complex_f :: Complex CFloat -> __exported by:__ @types\/complex\/hsb_complex_test.h@ -} multiply_complex_f = \x_0 -> \x_1 -> with x_1 (\y_2 -> with x_0 (\y_3 -> allocaAndPeek (\z_4 -> multiply_complex_f_wrapper y_3 y_2 z_4))) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_28f2705e917973ab" add_complex_wrapper_base :: BaseForeignType (Ptr (Complex CDouble) -> + Ptr (Complex CDouble) -> + Ptr (Complex CDouble) -> + IO Unit) +{-| Pointer-based API for 'add_complex' + +__unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_add_complex@ +-} +add_complex_wrapper :: Ptr (Complex CDouble) -> + Ptr (Complex CDouble) -> Ptr (Complex CDouble) -> IO Unit {-| Pointer-based API for 'add_complex' __unique:__ @test_typescomplexhsb_complex_test_Example_Unsafe_add_complex@ -} -foreign import ccall safe "hs_bindgen_28f2705e917973ab" add_complex_wrapper :: Ptr (Complex CDouble) -> - Ptr (Complex CDouble) -> - Ptr (Complex CDouble) -> - IO Unit +add_complex_wrapper = fromBaseForeignType add_complex_wrapper_base {-| __C declaration:__ @add_complex@ __defined at:__ @types\/complex\/hsb_complex_test.h:22:16@ @@ -293,11 +329,18 @@ add_complex :: Complex CDouble -> __exported by:__ @types\/complex\/hsb_complex_test.h@ -} add_complex = \x_0 -> \x_1 -> with x_1 (\y_2 -> with x_0 (\y_3 -> allocaAndPeek (\z_4 -> add_complex_wrapper y_3 y_2 z_4))) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8c8d85daac0162fd" hs_bindgen_8c8d85daac0162fd_base :: BaseForeignType (IO (FunPtr (Complex CFloat -> + Complex CFloat -> + IO (Complex CFloat)))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_multiply_complex_f_ptr@ -} -foreign import ccall safe "hs_bindgen_8c8d85daac0162fd" hs_bindgen_8c8d85daac0162fd :: IO (FunPtr (Complex CFloat -> - Complex CFloat -> - IO (Complex CFloat))) +hs_bindgen_8c8d85daac0162fd :: IO (FunPtr (Complex CFloat -> + Complex CFloat -> IO (Complex CFloat))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_multiply_complex_f_ptr@ +-} +hs_bindgen_8c8d85daac0162fd = fromBaseForeignType hs_bindgen_8c8d85daac0162fd_base {-# NOINLINE multiply_complex_f_ptr #-} {-| __C declaration:__ @multiply_complex_f@ @@ -314,11 +357,18 @@ multiply_complex_f_ptr :: FunPtr (Complex CFloat -> __exported by:__ @types\/complex\/hsb_complex_test.h@ -} multiply_complex_f_ptr = unsafePerformIO hs_bindgen_8c8d85daac0162fd +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_656a87248425c79a" hs_bindgen_656a87248425c79a_base :: BaseForeignType (IO (FunPtr (Complex CDouble -> + Complex CDouble -> + IO (Complex CDouble)))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_add_complex_ptr@ +-} +hs_bindgen_656a87248425c79a :: IO (FunPtr (Complex CDouble -> + Complex CDouble -> IO (Complex CDouble))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_add_complex_ptr@ -} -foreign import ccall safe "hs_bindgen_656a87248425c79a" hs_bindgen_656a87248425c79a :: IO (FunPtr (Complex CDouble -> - Complex CDouble -> - IO (Complex CDouble))) +hs_bindgen_656a87248425c79a = fromBaseForeignType hs_bindgen_656a87248425c79a_base {-# NOINLINE add_complex_ptr #-} {-| __C declaration:__ @add_complex@ @@ -335,9 +385,15 @@ add_complex_ptr :: FunPtr (Complex CDouble -> __exported by:__ @types\/complex\/hsb_complex_test.h@ -} add_complex_ptr = unsafePerformIO hs_bindgen_656a87248425c79a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a6dcbf0ebef057c9" hs_bindgen_a6dcbf0ebef057c9_base :: BaseForeignType (IO (Ptr (Complex CFloat))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_float_ptr@ +-} +hs_bindgen_a6dcbf0ebef057c9 :: IO (Ptr (Complex CFloat)) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_float_ptr@ -} -foreign import ccall safe "hs_bindgen_a6dcbf0ebef057c9" hs_bindgen_a6dcbf0ebef057c9 :: IO (Ptr (Complex CFloat)) +hs_bindgen_a6dcbf0ebef057c9 = fromBaseForeignType hs_bindgen_a6dcbf0ebef057c9_base {-# NOINLINE global_complex_float_ptr #-} {-| __C declaration:__ @global_complex_float@ @@ -353,9 +409,15 @@ global_complex_float_ptr :: Ptr (Complex CFloat) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} global_complex_float_ptr = unsafePerformIO hs_bindgen_a6dcbf0ebef057c9 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_6102571a73986812" hs_bindgen_6102571a73986812_base :: BaseForeignType (IO (Ptr (Complex CDouble))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_double_ptr@ -} -foreign import ccall safe "hs_bindgen_6102571a73986812" hs_bindgen_6102571a73986812 :: IO (Ptr (Complex CDouble)) +hs_bindgen_6102571a73986812 :: IO (Ptr (Complex CDouble)) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_double_ptr@ +-} +hs_bindgen_6102571a73986812 = fromBaseForeignType hs_bindgen_6102571a73986812_base {-# NOINLINE global_complex_double_ptr #-} {-| __C declaration:__ @global_complex_double@ @@ -371,9 +433,15 @@ global_complex_double_ptr :: Ptr (Complex CDouble) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} global_complex_double_ptr = unsafePerformIO hs_bindgen_6102571a73986812 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1b0a02397e2ea2f6" hs_bindgen_1b0a02397e2ea2f6_base :: BaseForeignType (IO (Ptr (Complex CFloat))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_float_flipped_ptr@ +-} +hs_bindgen_1b0a02397e2ea2f6 :: IO (Ptr (Complex CFloat)) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_float_flipped_ptr@ -} -foreign import ccall safe "hs_bindgen_1b0a02397e2ea2f6" hs_bindgen_1b0a02397e2ea2f6 :: IO (Ptr (Complex CFloat)) +hs_bindgen_1b0a02397e2ea2f6 = fromBaseForeignType hs_bindgen_1b0a02397e2ea2f6_base {-# NOINLINE global_complex_float_flipped_ptr #-} {-| __C declaration:__ @global_complex_float_flipped@ @@ -389,9 +457,15 @@ global_complex_float_flipped_ptr :: Ptr (Complex CFloat) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} global_complex_float_flipped_ptr = unsafePerformIO hs_bindgen_1b0a02397e2ea2f6 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4be2464f88314410" hs_bindgen_4be2464f88314410_base :: BaseForeignType (IO (Ptr (Complex CDouble))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_double_flipped_ptr@ -} -foreign import ccall safe "hs_bindgen_4be2464f88314410" hs_bindgen_4be2464f88314410 :: IO (Ptr (Complex CDouble)) +hs_bindgen_4be2464f88314410 :: IO (Ptr (Complex CDouble)) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_complex_double_flipped_ptr@ +-} +hs_bindgen_4be2464f88314410 = fromBaseForeignType hs_bindgen_4be2464f88314410_base {-# NOINLINE global_complex_double_flipped_ptr #-} {-| __C declaration:__ @global_complex_double_flipped@ @@ -407,9 +481,15 @@ global_complex_double_flipped_ptr :: Ptr (Complex CDouble) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} global_complex_double_flipped_ptr = unsafePerformIO hs_bindgen_4be2464f88314410 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aa07323f7398ff97" hs_bindgen_aa07323f7398ff97_base :: BaseForeignType (IO (Ptr (Complex CFloat))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_float_ptr@ -} -foreign import ccall safe "hs_bindgen_aa07323f7398ff97" hs_bindgen_aa07323f7398ff97 :: IO (Ptr (Complex CFloat)) +hs_bindgen_aa07323f7398ff97 :: IO (Ptr (Complex CFloat)) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_float_ptr@ +-} +hs_bindgen_aa07323f7398ff97 = fromBaseForeignType hs_bindgen_aa07323f7398ff97_base {-# NOINLINE global_Complex_float_ptr #-} {-| __C declaration:__ @global_Complex_float@ @@ -425,9 +505,15 @@ global_Complex_float_ptr :: Ptr (Complex CFloat) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} global_Complex_float_ptr = unsafePerformIO hs_bindgen_aa07323f7398ff97 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_190b07a847b36556" hs_bindgen_190b07a847b36556_base :: BaseForeignType (IO (Ptr (Complex CDouble))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_double_ptr@ -} -foreign import ccall safe "hs_bindgen_190b07a847b36556" hs_bindgen_190b07a847b36556 :: IO (Ptr (Complex CDouble)) +hs_bindgen_190b07a847b36556 :: IO (Ptr (Complex CDouble)) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_double_ptr@ +-} +hs_bindgen_190b07a847b36556 = fromBaseForeignType hs_bindgen_190b07a847b36556_base {-# NOINLINE global_Complex_double_ptr #-} {-| __C declaration:__ @global_Complex_double@ @@ -443,9 +529,15 @@ global_Complex_double_ptr :: Ptr (Complex CDouble) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} global_Complex_double_ptr = unsafePerformIO hs_bindgen_190b07a847b36556 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_017435f1022a672c" hs_bindgen_017435f1022a672c_base :: BaseForeignType (IO (Ptr (Complex CFloat))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_float_flipped_ptr@ +-} +hs_bindgen_017435f1022a672c :: IO (Ptr (Complex CFloat)) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_float_flipped_ptr@ -} -foreign import ccall safe "hs_bindgen_017435f1022a672c" hs_bindgen_017435f1022a672c :: IO (Ptr (Complex CFloat)) +hs_bindgen_017435f1022a672c = fromBaseForeignType hs_bindgen_017435f1022a672c_base {-# NOINLINE global_Complex_float_flipped_ptr #-} {-| __C declaration:__ @global_Complex_float_flipped@ @@ -461,9 +553,15 @@ global_Complex_float_flipped_ptr :: Ptr (Complex CFloat) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} global_Complex_float_flipped_ptr = unsafePerformIO hs_bindgen_017435f1022a672c +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_aec6991fbd3ffdbb" hs_bindgen_aec6991fbd3ffdbb_base :: BaseForeignType (IO (Ptr (Complex CDouble))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_double_flipped_ptr@ +-} +hs_bindgen_aec6991fbd3ffdbb :: IO (Ptr (Complex CDouble)) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_global_Complex_double_flipped_ptr@ -} -foreign import ccall safe "hs_bindgen_aec6991fbd3ffdbb" hs_bindgen_aec6991fbd3ffdbb :: IO (Ptr (Complex CDouble)) +hs_bindgen_aec6991fbd3ffdbb = fromBaseForeignType hs_bindgen_aec6991fbd3ffdbb_base {-# NOINLINE global_Complex_double_flipped_ptr #-} {-| __C declaration:__ @global_Complex_double_flipped@ @@ -479,9 +577,15 @@ global_Complex_double_flipped_ptr :: Ptr (Complex CDouble) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} global_Complex_double_flipped_ptr = unsafePerformIO hs_bindgen_aec6991fbd3ffdbb +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3ea97dc5fdb27263" hs_bindgen_3ea97dc5fdb27263_base :: BaseForeignType (IO (Ptr (Complex CFloat))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_const_complex_float_ptr@ -} -foreign import ccall safe "hs_bindgen_3ea97dc5fdb27263" hs_bindgen_3ea97dc5fdb27263 :: IO (Ptr (Complex CFloat)) +hs_bindgen_3ea97dc5fdb27263 :: IO (Ptr (Complex CFloat)) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_const_complex_float_ptr@ +-} +hs_bindgen_3ea97dc5fdb27263 = fromBaseForeignType hs_bindgen_3ea97dc5fdb27263_base {-# NOINLINE const_complex_float_ptr #-} {-| __C declaration:__ @const_complex_float@ @@ -500,9 +604,15 @@ const_complex_float_ptr = unsafePerformIO hs_bindgen_3ea97dc5fdb27263 {-# NOINLINE const_complex_float #-} const_complex_float :: Complex CFloat const_complex_float = unsafePerformIO (peek const_complex_float_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_086209fa0eb9a3ee" hs_bindgen_086209fa0eb9a3ee_base :: BaseForeignType (IO (Ptr (Complex CDouble))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_const_complex_double_ptr@ +-} +hs_bindgen_086209fa0eb9a3ee :: IO (Ptr (Complex CDouble)) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_const_complex_double_ptr@ -} -foreign import ccall safe "hs_bindgen_086209fa0eb9a3ee" hs_bindgen_086209fa0eb9a3ee :: IO (Ptr (Complex CDouble)) +hs_bindgen_086209fa0eb9a3ee = fromBaseForeignType hs_bindgen_086209fa0eb9a3ee_base {-# NOINLINE const_complex_double_ptr #-} {-| __C declaration:__ @const_complex_double@ @@ -521,9 +631,15 @@ const_complex_double_ptr = unsafePerformIO hs_bindgen_086209fa0eb9a3ee {-# NOINLINE const_complex_double #-} const_complex_double :: Complex CDouble const_complex_double = unsafePerformIO (peek const_complex_double_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_00177fb0da38717b" hs_bindgen_00177fb0da38717b_base :: BaseForeignType (IO (Ptr (Complex CFloat))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_volatile_complex_float_ptr@ +-} +hs_bindgen_00177fb0da38717b :: IO (Ptr (Complex CFloat)) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_volatile_complex_float_ptr@ -} -foreign import ccall safe "hs_bindgen_00177fb0da38717b" hs_bindgen_00177fb0da38717b :: IO (Ptr (Complex CFloat)) +hs_bindgen_00177fb0da38717b = fromBaseForeignType hs_bindgen_00177fb0da38717b_base {-# NOINLINE volatile_complex_float_ptr #-} {-| __C declaration:__ @volatile_complex_float@ @@ -539,9 +655,15 @@ volatile_complex_float_ptr :: Ptr (Complex CFloat) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} volatile_complex_float_ptr = unsafePerformIO hs_bindgen_00177fb0da38717b +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_72f5727716adf5ac" hs_bindgen_72f5727716adf5ac_base :: BaseForeignType (IO (Ptr (Complex CDouble))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_volatile_complex_double_ptr@ -} -foreign import ccall safe "hs_bindgen_72f5727716adf5ac" hs_bindgen_72f5727716adf5ac :: IO (Ptr (Complex CDouble)) +hs_bindgen_72f5727716adf5ac :: IO (Ptr (Complex CDouble)) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_volatile_complex_double_ptr@ +-} +hs_bindgen_72f5727716adf5ac = fromBaseForeignType hs_bindgen_72f5727716adf5ac_base {-# NOINLINE volatile_complex_double_ptr #-} {-| __C declaration:__ @volatile_complex_double@ @@ -557,10 +679,17 @@ volatile_complex_double_ptr :: Ptr (Complex CDouble) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} volatile_complex_double_ptr = unsafePerformIO hs_bindgen_72f5727716adf5ac +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_229c51ee9572efe8" hs_bindgen_229c51ee9572efe8_base :: BaseForeignType (IO (Ptr (ConstantArray 10 + (Complex CFloat)))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_complex_float_array_ptr@ +-} +hs_bindgen_229c51ee9572efe8 :: IO (Ptr (ConstantArray 10 + (Complex CFloat))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_complex_float_array_ptr@ -} -foreign import ccall safe "hs_bindgen_229c51ee9572efe8" hs_bindgen_229c51ee9572efe8 :: IO (Ptr (ConstantArray 10 - (Complex CFloat))) +hs_bindgen_229c51ee9572efe8 = fromBaseForeignType hs_bindgen_229c51ee9572efe8_base {-# NOINLINE complex_float_array_ptr #-} {-| __C declaration:__ @complex_float_array@ @@ -576,10 +705,17 @@ complex_float_array_ptr :: Ptr (ConstantArray 10 (Complex CFloat)) __exported by:__ @types\/complex\/hsb_complex_test.h@ -} complex_float_array_ptr = unsafePerformIO hs_bindgen_229c51ee9572efe8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_b2b11d22608bbfec" hs_bindgen_b2b11d22608bbfec_base :: BaseForeignType (IO (Ptr (ConstantArray 10 + (Complex CDouble)))) +{-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_complex_double_array_ptr@ +-} +hs_bindgen_b2b11d22608bbfec :: IO (Ptr (ConstantArray 10 + (Complex CDouble))) {-| __unique:__ @test_typescomplexhsb_complex_test_Example_get_complex_double_array_ptr@ -} -foreign import ccall safe "hs_bindgen_b2b11d22608bbfec" hs_bindgen_b2b11d22608bbfec :: IO (Ptr (ConstantArray 10 - (Complex CDouble))) +hs_bindgen_b2b11d22608bbfec = fromBaseForeignType hs_bindgen_b2b11d22608bbfec_base {-# NOINLINE complex_double_array_ptr #-} {-| __C declaration:__ @complex_double_array@ diff --git a/hs-bindgen/fixtures/types/complex/vector_test/Example/FunPtr.hs b/hs-bindgen/fixtures/types/complex/vector_test/Example/FunPtr.hs index 517eb66f4..9a8d2952b 100644 --- a/hs-bindgen/fixtures/types/complex/vector_test/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/types/complex/vector_test/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -25,10 +26,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_a9bd57bd55b4e697" hs_bindgen_a9bd57bd55b4e697_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CDouble -> FC.CDouble -> IO (Ptr.Ptr Vector)))) + {-| __unique:__ @test_typescomplexvector_test_Example_get_new_vector_ptr@ -} -foreign import ccall unsafe "hs_bindgen_a9bd57bd55b4e697" hs_bindgen_a9bd57bd55b4e697 :: +hs_bindgen_a9bd57bd55b4e697 :: IO (Ptr.FunPtr (FC.CDouble -> FC.CDouble -> IO (Ptr.Ptr Vector))) +hs_bindgen_a9bd57bd55b4e697 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_a9bd57bd55b4e697_base {-# NOINLINE new_vector_ptr #-} diff --git a/hs-bindgen/fixtures/types/complex/vector_test/Example/Safe.hs b/hs-bindgen/fixtures/types/complex/vector_test/Example/Safe.hs index 35ae136ea..21e91b139 100644 --- a/hs-bindgen/fixtures/types/complex/vector_test/Example/Safe.hs +++ b/hs-bindgen/fixtures/types/complex/vector_test/Example/Safe.hs @@ -7,6 +7,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -22,6 +23,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cd5f566bc96dcba0" new_vector_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CDouble -> FC.CDouble -> IO (Ptr.Ptr Vector)) + {-| __C declaration:__ @new_vector@ __defined at:__ @types\/complex\/vector_test.h:6:9@ @@ -30,7 +36,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_typescomplexvector_test_Example_Safe_new_vector@ -} -foreign import ccall safe "hs_bindgen_cd5f566bc96dcba0" new_vector :: +new_vector :: FC.CDouble {- ^ __C declaration:__ @x@ -} @@ -38,3 +44,5 @@ foreign import ccall safe "hs_bindgen_cd5f566bc96dcba0" new_vector :: {- ^ __C declaration:__ @y@ -} -> IO (Ptr.Ptr Vector) +new_vector = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType new_vector_base diff --git a/hs-bindgen/fixtures/types/complex/vector_test/Example/Unsafe.hs b/hs-bindgen/fixtures/types/complex/vector_test/Example/Unsafe.hs index b408e0467..57df796b5 100644 --- a/hs-bindgen/fixtures/types/complex/vector_test/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/types/complex/vector_test/Example/Unsafe.hs @@ -7,6 +7,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -22,6 +23,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1af353788955c7a2" new_vector_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CDouble -> FC.CDouble -> IO (Ptr.Ptr Vector)) + {-| __C declaration:__ @new_vector@ __defined at:__ @types\/complex\/vector_test.h:6:9@ @@ -30,7 +36,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_typescomplexvector_test_Example_Unsafe_new_vector@ -} -foreign import ccall unsafe "hs_bindgen_1af353788955c7a2" new_vector :: +new_vector :: FC.CDouble {- ^ __C declaration:__ @x@ -} @@ -38,3 +44,5 @@ foreign import ccall unsafe "hs_bindgen_1af353788955c7a2" new_vector :: {- ^ __C declaration:__ @y@ -} -> IO (Ptr.Ptr Vector) +new_vector = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType new_vector_base diff --git a/hs-bindgen/fixtures/types/complex/vector_test/th.txt b/hs-bindgen/fixtures/types/complex/vector_test/th.txt index 0fae720a1..25cd94b8f 100644 --- a/hs-bindgen/fixtures/types/complex/vector_test/th.txt +++ b/hs-bindgen/fixtures/types/complex/vector_test/th.txt @@ -66,6 +66,11 @@ instance HasCField Vector "vector_y" instance TyEq ty (CFieldType Vector "vector_y") => HasField "vector_y" (Ptr Vector) (Ptr ty) where getField = ptrToCField (Proxy @"vector_y") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cd5f566bc96dcba0" new_vector_base :: BaseForeignType (CDouble -> + CDouble -> + IO (Ptr Vector)) {-| __C declaration:__ @new_vector@ __defined at:__ @types\/complex\/vector_test.h:6:9@ @@ -74,8 +79,7 @@ instance TyEq ty (CFieldType Vector "vector_y") => __unique:__ @test_typescomplexvector_test_Example_Unsafe_new_vector@ -} -foreign import ccall safe "hs_bindgen_cd5f566bc96dcba0" new_vector :: CDouble -> - CDouble -> IO (Ptr Vector) +new_vector :: CDouble -> CDouble -> IO (Ptr Vector) {-| __C declaration:__ @new_vector@ __defined at:__ @types\/complex\/vector_test.h:6:9@ @@ -84,13 +88,42 @@ foreign import ccall safe "hs_bindgen_cd5f566bc96dcba0" new_vector :: CDouble -> __unique:__ @test_typescomplexvector_test_Example_Unsafe_new_vector@ -} -foreign import ccall safe "hs_bindgen_1af353788955c7a2" new_vector :: CDouble -> - CDouble -> IO (Ptr Vector) +new_vector = fromBaseForeignType new_vector_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1af353788955c7a2" new_vector_base :: BaseForeignType (CDouble -> + CDouble -> + IO (Ptr Vector)) +{-| __C declaration:__ @new_vector@ + + __defined at:__ @types\/complex\/vector_test.h:6:9@ + + __exported by:__ @types\/complex\/vector_test.h@ + + __unique:__ @test_typescomplexvector_test_Example_Unsafe_new_vector@ +-} +new_vector :: CDouble -> CDouble -> IO (Ptr Vector) +{-| __C declaration:__ @new_vector@ + + __defined at:__ @types\/complex\/vector_test.h:6:9@ + + __exported by:__ @types\/complex\/vector_test.h@ + + __unique:__ @test_typescomplexvector_test_Example_Unsafe_new_vector@ +-} +new_vector = fromBaseForeignType new_vector_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a9bd57bd55b4e697" hs_bindgen_a9bd57bd55b4e697_base :: BaseForeignType (IO (FunPtr (CDouble -> + CDouble -> + IO (Ptr Vector)))) +{-| __unique:__ @test_typescomplexvector_test_Example_get_new_vector_ptr@ +-} +hs_bindgen_a9bd57bd55b4e697 :: IO (FunPtr (CDouble -> + CDouble -> IO (Ptr Vector))) {-| __unique:__ @test_typescomplexvector_test_Example_get_new_vector_ptr@ -} -foreign import ccall safe "hs_bindgen_a9bd57bd55b4e697" hs_bindgen_a9bd57bd55b4e697 :: IO (FunPtr (CDouble -> - CDouble -> - IO (Ptr Vector))) +hs_bindgen_a9bd57bd55b4e697 = fromBaseForeignType hs_bindgen_a9bd57bd55b4e697_base {-# NOINLINE new_vector_ptr #-} {-| __C declaration:__ @new_vector@ diff --git a/hs-bindgen/fixtures/types/primitives/bool_c23/Example/Global.hs b/hs-bindgen/fixtures/types/primitives/bool_c23/Example/Global.hs index e17d0efae..063a20400 100644 --- a/hs-bindgen/fixtures/types/primitives/bool_c23/Example/Global.hs +++ b/hs-bindgen/fixtures/types/primitives/bool_c23/Example/Global.hs @@ -8,6 +8,7 @@ module Example.Global where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -21,10 +22,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_1e3421d11afdb5be" hs_bindgen_1e3421d11afdb5be_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CBool)) + {-| __unique:__ @test_typesprimitivesbool_c23_Example_get_b_ptr@ -} -foreign import ccall unsafe "hs_bindgen_1e3421d11afdb5be" hs_bindgen_1e3421d11afdb5be :: +hs_bindgen_1e3421d11afdb5be :: IO (Ptr.Ptr FC.CBool) +hs_bindgen_1e3421d11afdb5be = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_1e3421d11afdb5be_base {-# NOINLINE b_ptr #-} diff --git a/hs-bindgen/fixtures/types/primitives/bool_c23/th.txt b/hs-bindgen/fixtures/types/primitives/bool_c23/th.txt index c6b5220ba..991fc6a70 100644 --- a/hs-bindgen/fixtures/types/primitives/bool_c23/th.txt +++ b/hs-bindgen/fixtures/types/primitives/bool_c23/th.txt @@ -6,9 +6,15 @@ -- { -- return &b; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_1e3421d11afdb5be" hs_bindgen_1e3421d11afdb5be_base :: BaseForeignType (IO (Ptr CBool)) +{-| __unique:__ @test_typesprimitivesbool_c23_Example_get_b_ptr@ +-} +hs_bindgen_1e3421d11afdb5be :: IO (Ptr CBool) {-| __unique:__ @test_typesprimitivesbool_c23_Example_get_b_ptr@ -} -foreign import ccall safe "hs_bindgen_1e3421d11afdb5be" hs_bindgen_1e3421d11afdb5be :: IO (Ptr CBool) +hs_bindgen_1e3421d11afdb5be = fromBaseForeignType hs_bindgen_1e3421d11afdb5be_base {-# NOINLINE b_ptr #-} {-| __C declaration:__ @b@ diff --git a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/FunPtr.hs b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/FunPtr.hs index 74c56252b..03f14e2d8 100644 --- a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -24,10 +25,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_33c0388dc987452a" hs_bindgen_33c0388dc987452a_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr ((Ptr.Ptr (Ptr.Ptr FC.CChar)) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CBool))) + {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_list_example_ptr@ -} -foreign import ccall unsafe "hs_bindgen_33c0388dc987452a" hs_bindgen_33c0388dc987452a :: +hs_bindgen_33c0388dc987452a :: IO (Ptr.FunPtr ((Ptr.Ptr (Ptr.Ptr FC.CChar)) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CBool)) +hs_bindgen_33c0388dc987452a = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_33c0388dc987452a_base {-# NOINLINE list_example_ptr #-} diff --git a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Global.hs b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Global.hs index ce59e60d4..8c138e9d5 100644 --- a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Global.hs +++ b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Global.hs @@ -9,6 +9,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -40,10 +41,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_64d60cae0690e115" hs_bindgen_64d60cae0690e115_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr FC.CInt)) + {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_a_ptr@ -} -foreign import ccall unsafe "hs_bindgen_64d60cae0690e115" hs_bindgen_64d60cae0690e115 :: +hs_bindgen_64d60cae0690e115 :: IO (Ptr.Ptr FC.CInt) +hs_bindgen_64d60cae0690e115 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_64d60cae0690e115_base {-# NOINLINE a_ptr #-} @@ -62,10 +70,17 @@ a_ptr = a :: FC.CInt a = GHC.IO.Unsafe.unsafePerformIO (F.peek a_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e2844224d896e170" hs_bindgen_e2844224d896e170_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) + {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_b_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e2844224d896e170" hs_bindgen_e2844224d896e170 :: +hs_bindgen_e2844224d896e170 :: IO (Ptr.Ptr (Ptr.Ptr FC.CInt)) +hs_bindgen_e2844224d896e170 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e2844224d896e170_base {-# NOINLINE b_ptr #-} @@ -79,10 +94,17 @@ b_ptr :: Ptr.Ptr (Ptr.Ptr FC.CInt) b_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e2844224d896e170 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_ab653695917fba40" hs_bindgen_ab653695917fba40_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) + {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_c_ptr@ -} -foreign import ccall unsafe "hs_bindgen_ab653695917fba40" hs_bindgen_ab653695917fba40 :: +hs_bindgen_ab653695917fba40 :: IO (Ptr.Ptr (Ptr.Ptr FC.CInt)) +hs_bindgen_ab653695917fba40 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_ab653695917fba40_base {-# NOINLINE c_ptr #-} @@ -101,10 +123,17 @@ c_ptr = c :: Ptr.Ptr FC.CInt c = GHC.IO.Unsafe.unsafePerformIO (F.peek c_ptr) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8e02c92809ce6a69" hs_bindgen_8e02c92809ce6a69_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.Ptr (Ptr.Ptr FC.CInt))) + {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_d_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8e02c92809ce6a69" hs_bindgen_8e02c92809ce6a69 :: +hs_bindgen_8e02c92809ce6a69 :: IO (Ptr.Ptr (Ptr.Ptr FC.CInt)) +hs_bindgen_8e02c92809ce6a69 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8e02c92809ce6a69_base {-# NOINLINE d_ptr #-} diff --git a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Safe.hs b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Safe.hs index 74b91ac0e..87ea5255b 100644 --- a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Safe.hs +++ b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Safe.hs @@ -7,6 +7,7 @@ module Example.Safe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -21,6 +22,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_32187cc02676ee72" list_example_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr FC.CChar)) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CBool) + {-| __C declaration:__ @list_example@ __defined at:__ @types\/qualifiers\/type_qualifiers.h:14:6@ @@ -29,7 +35,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_typesqualifierstype_qualifie_Example_Safe_list_example@ -} -foreign import ccall safe "hs_bindgen_32187cc02676ee72" list_example :: +list_example :: Ptr.Ptr (Ptr.Ptr FC.CChar) {- ^ __C declaration:__ @items@ -} @@ -37,3 +43,5 @@ foreign import ccall safe "hs_bindgen_32187cc02676ee72" list_example :: {- ^ __C declaration:__ @count@ -} -> IO FC.CBool +list_example = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType list_example_base diff --git a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Unsafe.hs b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Unsafe.hs index 9a7487586..bdce5e36d 100644 --- a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/Example/Unsafe.hs @@ -7,6 +7,7 @@ module Example.Unsafe where import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -21,6 +22,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_360934a08f19eaab" list_example_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr (Ptr.Ptr FC.CChar)) -> HsBindgen.Runtime.Prelude.CSize -> IO FC.CBool) + {-| __C declaration:__ @list_example@ __defined at:__ @types\/qualifiers\/type_qualifiers.h:14:6@ @@ -29,7 +35,7 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_typesqualifierstype_qualifie_Example_Unsafe_list_example@ -} -foreign import ccall unsafe "hs_bindgen_360934a08f19eaab" list_example :: +list_example :: Ptr.Ptr (Ptr.Ptr FC.CChar) {- ^ __C declaration:__ @items@ -} @@ -37,3 +43,5 @@ foreign import ccall unsafe "hs_bindgen_360934a08f19eaab" list_example :: {- ^ __C declaration:__ @count@ -} -> IO FC.CBool +list_example = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType list_example_base diff --git a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/th.txt b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/th.txt index 7244c1cc8..30cfb85bb 100644 --- a/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/th.txt +++ b/hs-bindgen/fixtures/types/qualifiers/type_qualifiers/th.txt @@ -50,6 +50,11 @@ -- { -- return &d; -- } +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_32187cc02676ee72" list_example_base :: BaseForeignType (Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> + IO CBool) {-| __C declaration:__ @list_example@ __defined at:__ @types\/qualifiers\/type_qualifiers.h:14:6@ @@ -58,9 +63,8 @@ __unique:__ @test_typesqualifierstype_qualifie_Example_Unsafe_list_example@ -} -foreign import ccall safe "hs_bindgen_32187cc02676ee72" list_example :: Ptr (Ptr CChar) -> - HsBindgen.Runtime.Prelude.CSize -> - IO CBool +list_example :: Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> IO CBool {-| __C declaration:__ @list_example@ __defined at:__ @types\/qualifiers\/type_qualifiers.h:14:6@ @@ -69,14 +73,43 @@ foreign import ccall safe "hs_bindgen_32187cc02676ee72" list_example :: Ptr (Ptr __unique:__ @test_typesqualifierstype_qualifie_Example_Unsafe_list_example@ -} -foreign import ccall safe "hs_bindgen_360934a08f19eaab" list_example :: Ptr (Ptr CChar) -> - HsBindgen.Runtime.Prelude.CSize -> - IO CBool +list_example = fromBaseForeignType list_example_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_360934a08f19eaab" list_example_base :: BaseForeignType (Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> + IO CBool) +{-| __C declaration:__ @list_example@ + + __defined at:__ @types\/qualifiers\/type_qualifiers.h:14:6@ + + __exported by:__ @types\/qualifiers\/type_qualifiers.h@ + + __unique:__ @test_typesqualifierstype_qualifie_Example_Unsafe_list_example@ +-} +list_example :: Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> IO CBool +{-| __C declaration:__ @list_example@ + + __defined at:__ @types\/qualifiers\/type_qualifiers.h:14:6@ + + __exported by:__ @types\/qualifiers\/type_qualifiers.h@ + + __unique:__ @test_typesqualifierstype_qualifie_Example_Unsafe_list_example@ +-} +list_example = fromBaseForeignType list_example_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_33c0388dc987452a" hs_bindgen_33c0388dc987452a_base :: BaseForeignType (IO (FunPtr (Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> + IO CBool))) +{-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_list_example_ptr@ +-} +hs_bindgen_33c0388dc987452a :: IO (FunPtr (Ptr (Ptr CChar) -> + HsBindgen.Runtime.Prelude.CSize -> IO CBool)) {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_list_example_ptr@ -} -foreign import ccall safe "hs_bindgen_33c0388dc987452a" hs_bindgen_33c0388dc987452a :: IO (FunPtr (Ptr (Ptr CChar) -> - HsBindgen.Runtime.Prelude.CSize -> - IO CBool)) +hs_bindgen_33c0388dc987452a = fromBaseForeignType hs_bindgen_33c0388dc987452a_base {-# NOINLINE list_example_ptr #-} {-| __C declaration:__ @list_example@ @@ -93,9 +126,15 @@ list_example_ptr :: FunPtr (Ptr (Ptr CChar) -> __exported by:__ @types\/qualifiers\/type_qualifiers.h@ -} list_example_ptr = unsafePerformIO hs_bindgen_33c0388dc987452a +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_64d60cae0690e115" hs_bindgen_64d60cae0690e115_base :: BaseForeignType (IO (Ptr CInt)) +{-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_a_ptr@ +-} +hs_bindgen_64d60cae0690e115 :: IO (Ptr CInt) {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_a_ptr@ -} -foreign import ccall safe "hs_bindgen_64d60cae0690e115" hs_bindgen_64d60cae0690e115 :: IO (Ptr CInt) +hs_bindgen_64d60cae0690e115 = fromBaseForeignType hs_bindgen_64d60cae0690e115_base {-# NOINLINE a_ptr #-} {-| __C declaration:__ @a@ @@ -114,9 +153,15 @@ a_ptr = unsafePerformIO hs_bindgen_64d60cae0690e115 {-# NOINLINE a #-} a :: CInt a = unsafePerformIO (peek a_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e2844224d896e170" hs_bindgen_e2844224d896e170_base :: BaseForeignType (IO (Ptr (Ptr CInt))) {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_b_ptr@ -} -foreign import ccall safe "hs_bindgen_e2844224d896e170" hs_bindgen_e2844224d896e170 :: IO (Ptr (Ptr CInt)) +hs_bindgen_e2844224d896e170 :: IO (Ptr (Ptr CInt)) +{-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_b_ptr@ +-} +hs_bindgen_e2844224d896e170 = fromBaseForeignType hs_bindgen_e2844224d896e170_base {-# NOINLINE b_ptr #-} {-| __C declaration:__ @b@ @@ -132,9 +177,15 @@ b_ptr :: Ptr (Ptr CInt) __exported by:__ @types\/qualifiers\/type_qualifiers.h@ -} b_ptr = unsafePerformIO hs_bindgen_e2844224d896e170 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_ab653695917fba40" hs_bindgen_ab653695917fba40_base :: BaseForeignType (IO (Ptr (Ptr CInt))) +{-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_c_ptr@ +-} +hs_bindgen_ab653695917fba40 :: IO (Ptr (Ptr CInt)) {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_c_ptr@ -} -foreign import ccall safe "hs_bindgen_ab653695917fba40" hs_bindgen_ab653695917fba40 :: IO (Ptr (Ptr CInt)) +hs_bindgen_ab653695917fba40 = fromBaseForeignType hs_bindgen_ab653695917fba40_base {-# NOINLINE c_ptr #-} {-| __C declaration:__ @c@ @@ -153,9 +204,15 @@ c_ptr = unsafePerformIO hs_bindgen_ab653695917fba40 {-# NOINLINE c #-} c :: Ptr CInt c = unsafePerformIO (peek c_ptr) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8e02c92809ce6a69" hs_bindgen_8e02c92809ce6a69_base :: BaseForeignType (IO (Ptr (Ptr CInt))) +{-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_d_ptr@ +-} +hs_bindgen_8e02c92809ce6a69 :: IO (Ptr (Ptr CInt)) {-| __unique:__ @test_typesqualifierstype_qualifie_Example_get_d_ptr@ -} -foreign import ccall safe "hs_bindgen_8e02c92809ce6a69" hs_bindgen_8e02c92809ce6a69 :: IO (Ptr (Ptr CInt)) +hs_bindgen_8e02c92809ce6a69 = fromBaseForeignType hs_bindgen_8e02c92809ce6a69_base {-# NOINLINE d_ptr #-} {-| __C declaration:__ @d@ diff --git a/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/FunPtr.hs b/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/FunPtr.hs index 6730c19df..64ad91835 100644 --- a/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -23,10 +24,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c526f22b76547216" hs_bindgen_c526f22b76547216_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO ()))) + {-| __unique:__ @test_typesspecialparse_failure_lo_Example_get_fun2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_c526f22b76547216" hs_bindgen_c526f22b76547216 :: +hs_bindgen_c526f22b76547216 :: IO (Ptr.FunPtr (FC.CInt -> IO ())) +hs_bindgen_c526f22b76547216 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_c526f22b76547216_base {-# NOINLINE fun2_ptr #-} diff --git a/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/Safe.hs b/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/Safe.hs index 55e87335e..592682f93 100644 --- a/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/Safe.hs +++ b/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/Safe.hs @@ -6,6 +6,7 @@ module Example.Safe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -19,6 +20,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a1252a3becef09a6" fun2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO ()) + {-| __C declaration:__ @fun2@ __defined at:__ @types\/special\/parse_failure_long_double.h:7:6@ @@ -27,6 +33,8 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_typesspecialparse_failure_lo_Example_Safe_fun2@ -} -foreign import ccall safe "hs_bindgen_a1252a3becef09a6" fun2 :: +fun2 :: FC.CInt -> IO () +fun2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun2_base diff --git a/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/Unsafe.hs b/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/Unsafe.hs index 40fd4a959..99146dcd5 100644 --- a/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/types/special/parse_failure_long_double/Example/Unsafe.hs @@ -6,6 +6,7 @@ module Example.Unsafe where import qualified Foreign.C as FC +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Prelude (IO) @@ -19,6 +20,11 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_61793546aa44e36b" fun2_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> IO ()) + {-| __C declaration:__ @fun2@ __defined at:__ @types\/special\/parse_failure_long_double.h:7:6@ @@ -27,6 +33,8 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines __unique:__ @test_typesspecialparse_failure_lo_Example_Unsafe_fun2@ -} -foreign import ccall unsafe "hs_bindgen_61793546aa44e36b" fun2 :: +fun2 :: FC.CInt -> IO () +fun2 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType fun2_base diff --git a/hs-bindgen/fixtures/types/special/parse_failure_long_double/th.txt b/hs-bindgen/fixtures/types/special/parse_failure_long_double/th.txt index d0a105862..4d8c7b019 100644 --- a/hs-bindgen/fixtures/types/special/parse_failure_long_double/th.txt +++ b/hs-bindgen/fixtures/types/special/parse_failure_long_double/th.txt @@ -53,6 +53,10 @@ instance HasCField Struct2 "struct2_x" instance TyEq ty (CFieldType Struct2 "struct2_x") => HasField "struct2_x" (Ptr Struct2) (Ptr ty) where getField = ptrToCField (Proxy @"struct2_x") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_a1252a3becef09a6" fun2_base :: BaseForeignType (CInt -> + IO Unit) {-| __C declaration:__ @fun2@ __defined at:__ @types\/special\/parse_failure_long_double.h:7:6@ @@ -61,8 +65,7 @@ instance TyEq ty (CFieldType Struct2 "struct2_x") => __unique:__ @test_typesspecialparse_failure_lo_Example_Unsafe_fun2@ -} -foreign import ccall safe "hs_bindgen_a1252a3becef09a6" fun2 :: CInt -> - IO Unit +fun2 :: CInt -> IO Unit {-| __C declaration:__ @fun2@ __defined at:__ @types\/special\/parse_failure_long_double.h:7:6@ @@ -71,12 +74,39 @@ foreign import ccall safe "hs_bindgen_a1252a3becef09a6" fun2 :: CInt -> __unique:__ @test_typesspecialparse_failure_lo_Example_Unsafe_fun2@ -} -foreign import ccall safe "hs_bindgen_61793546aa44e36b" fun2 :: CInt -> - IO Unit +fun2 = fromBaseForeignType fun2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_61793546aa44e36b" fun2_base :: BaseForeignType (CInt -> + IO Unit) +{-| __C declaration:__ @fun2@ + + __defined at:__ @types\/special\/parse_failure_long_double.h:7:6@ + + __exported by:__ @types\/special\/parse_failure_long_double.h@ + + __unique:__ @test_typesspecialparse_failure_lo_Example_Unsafe_fun2@ +-} +fun2 :: CInt -> IO Unit +{-| __C declaration:__ @fun2@ + + __defined at:__ @types\/special\/parse_failure_long_double.h:7:6@ + + __exported by:__ @types\/special\/parse_failure_long_double.h@ + + __unique:__ @test_typesspecialparse_failure_lo_Example_Unsafe_fun2@ +-} +fun2 = fromBaseForeignType fun2_base +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c526f22b76547216" hs_bindgen_c526f22b76547216_base :: BaseForeignType (IO (FunPtr (CInt -> + IO Unit))) +{-| __unique:__ @test_typesspecialparse_failure_lo_Example_get_fun2_ptr@ +-} +hs_bindgen_c526f22b76547216 :: IO (FunPtr (CInt -> IO Unit)) {-| __unique:__ @test_typesspecialparse_failure_lo_Example_get_fun2_ptr@ -} -foreign import ccall safe "hs_bindgen_c526f22b76547216" hs_bindgen_c526f22b76547216 :: IO (FunPtr (CInt -> - IO Unit)) +hs_bindgen_c526f22b76547216 = fromBaseForeignType hs_bindgen_c526f22b76547216_base {-# NOINLINE fun2_ptr #-} {-| __C declaration:__ @fun2@ diff --git a/hs-bindgen/fixtures/types/structs/struct_arg/Example/FunPtr.hs b/hs-bindgen/fixtures/types/structs/struct_arg/Example/FunPtr.hs index 76f7f2026..382f1acc7 100644 --- a/hs-bindgen/fixtures/types/structs/struct_arg/Example/FunPtr.hs +++ b/hs-bindgen/fixtures/types/structs/struct_arg/Example/FunPtr.hs @@ -8,6 +8,7 @@ module Example.FunPtr where import qualified Foreign.C as FC import qualified GHC.IO.Unsafe import qualified GHC.Ptr as Ptr +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -52,10 +53,17 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_025103be0a357629" hs_bindgen_025103be0a357629_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (Thing -> IO FC.CInt))) + {-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_1_ptr@ -} -foreign import ccall unsafe "hs_bindgen_025103be0a357629" hs_bindgen_025103be0a357629 :: +hs_bindgen_025103be0a357629 :: IO (Ptr.FunPtr (Thing -> IO FC.CInt)) +hs_bindgen_025103be0a357629 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_025103be0a357629_base {-# NOINLINE thing_fun_1_ptr #-} @@ -69,10 +77,17 @@ thing_fun_1_ptr :: Ptr.FunPtr (Thing -> IO FC.CInt) thing_fun_1_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_025103be0a357629 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_e66f3bfa6ad4e4c8" hs_bindgen_e66f3bfa6ad4e4c8_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> IO Thing))) + {-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_2_ptr@ -} -foreign import ccall unsafe "hs_bindgen_e66f3bfa6ad4e4c8" hs_bindgen_e66f3bfa6ad4e4c8 :: +hs_bindgen_e66f3bfa6ad4e4c8 :: IO (Ptr.FunPtr (FC.CInt -> IO Thing)) +hs_bindgen_e66f3bfa6ad4e4c8 = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_e66f3bfa6ad4e4c8_base {-# NOINLINE thing_fun_2_ptr #-} @@ -86,10 +101,17 @@ thing_fun_2_ptr :: Ptr.FunPtr (FC.CInt -> IO Thing) thing_fun_2_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_e66f3bfa6ad4e4c8 +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_5fea3576dcdc292f" hs_bindgen_5fea3576dcdc292f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> Thing -> FC.CDouble -> IO Thing))) + {-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_3a_ptr@ -} -foreign import ccall unsafe "hs_bindgen_5fea3576dcdc292f" hs_bindgen_5fea3576dcdc292f :: +hs_bindgen_5fea3576dcdc292f :: IO (Ptr.FunPtr (FC.CInt -> Thing -> FC.CDouble -> IO Thing)) +hs_bindgen_5fea3576dcdc292f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_5fea3576dcdc292f_base {-# NOINLINE thing_fun_3a_ptr #-} @@ -103,10 +125,17 @@ thing_fun_3a_ptr :: Ptr.FunPtr (FC.CInt -> Thing -> FC.CDouble -> IO Thing) thing_fun_3a_ptr = GHC.IO.Unsafe.unsafePerformIO hs_bindgen_5fea3576dcdc292f +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_8df67f0e3a4b504f" hs_bindgen_8df67f0e3a4b504f_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (IO (Ptr.FunPtr (FC.CInt -> Thing -> FC.CDouble -> IO FC.CChar))) + {-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_3b_ptr@ -} -foreign import ccall unsafe "hs_bindgen_8df67f0e3a4b504f" hs_bindgen_8df67f0e3a4b504f :: +hs_bindgen_8df67f0e3a4b504f :: IO (Ptr.FunPtr (FC.CInt -> Thing -> FC.CDouble -> IO FC.CChar)) +hs_bindgen_8df67f0e3a4b504f = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType hs_bindgen_8df67f0e3a4b504f_base {-# NOINLINE thing_fun_3b_ptr #-} diff --git a/hs-bindgen/fixtures/types/structs/struct_arg/Example/Safe.hs b/hs-bindgen/fixtures/types/structs/struct_arg/Example/Safe.hs index 3539673a1..e828e89d3 100644 --- a/hs-bindgen/fixtures/types/structs/struct_arg/Example/Safe.hs +++ b/hs-bindgen/fixtures/types/structs/struct_arg/Example/Safe.hs @@ -9,6 +9,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.CAPI +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -47,13 +48,20 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4ad25504590fdd2b" thing_fun_1_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Thing) -> IO FC.CInt) + {-| Pointer-based API for 'thing_fun_1' __unique:__ @test_typesstructsstruct_arg_Example_Safe_thing_fun_1@ -} -foreign import ccall safe "hs_bindgen_4ad25504590fdd2b" thing_fun_1_wrapper :: +thing_fun_1_wrapper :: Ptr.Ptr Thing -> IO FC.CInt +thing_fun_1_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType thing_fun_1_wrapper_base {-| __C declaration:__ @thing_fun_1@ @@ -69,14 +77,21 @@ thing_fun_1 :: thing_fun_1 = \x0 -> F.with x0 (\y1 -> thing_fun_1_wrapper y1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_04a435522bf64978" thing_fun_2_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr Thing) -> IO ()) + {-| Pointer-based API for 'thing_fun_2' __unique:__ @test_typesstructsstruct_arg_Example_Safe_thing_fun_2@ -} -foreign import ccall safe "hs_bindgen_04a435522bf64978" thing_fun_2_wrapper :: +thing_fun_2_wrapper :: FC.CInt -> Ptr.Ptr Thing -> IO () +thing_fun_2_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType thing_fun_2_wrapper_base {-| __C declaration:__ @thing_fun_2@ @@ -94,16 +109,23 @@ thing_fun_2 = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> thing_fun_2_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5e3271324df7ced2" thing_fun_3a_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr Thing) -> FC.CDouble -> (Ptr.Ptr Thing) -> IO ()) + {-| Pointer-based API for 'thing_fun_3a' __unique:__ @test_typesstructsstruct_arg_Example_Safe_thing_fun_3a@ -} -foreign import ccall safe "hs_bindgen_5e3271324df7ced2" thing_fun_3a_wrapper :: +thing_fun_3a_wrapper :: FC.CInt -> Ptr.Ptr Thing -> FC.CDouble -> Ptr.Ptr Thing -> IO () +thing_fun_3a_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType thing_fun_3a_wrapper_base {-| __C declaration:__ @thing_fun_3a@ @@ -130,15 +152,22 @@ thing_fun_3a = HsBindgen.Runtime.CAPI.allocaAndPeek (\z4 -> thing_fun_3a_wrapper x0 y3 x2 z4)) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3525c7d1c72f2fae" thing_fun_3b_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr Thing) -> FC.CDouble -> IO FC.CChar) + {-| Pointer-based API for 'thing_fun_3b' __unique:__ @test_typesstructsstruct_arg_Example_Safe_thing_fun_3b@ -} -foreign import ccall safe "hs_bindgen_3525c7d1c72f2fae" thing_fun_3b_wrapper :: +thing_fun_3b_wrapper :: FC.CInt -> Ptr.Ptr Thing -> FC.CDouble -> IO FC.CChar +thing_fun_3b_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType thing_fun_3b_wrapper_base {-| __C declaration:__ @thing_fun_3b@ diff --git a/hs-bindgen/fixtures/types/structs/struct_arg/Example/Unsafe.hs b/hs-bindgen/fixtures/types/structs/struct_arg/Example/Unsafe.hs index 62d44b073..b7b3bd509 100644 --- a/hs-bindgen/fixtures/types/structs/struct_arg/Example/Unsafe.hs +++ b/hs-bindgen/fixtures/types/structs/struct_arg/Example/Unsafe.hs @@ -9,6 +9,7 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified GHC.Ptr as Ptr import qualified HsBindgen.Runtime.CAPI +import qualified HsBindgen.Runtime.HasBaseForeignType import qualified HsBindgen.Runtime.Prelude import Example import Prelude (IO) @@ -47,13 +48,20 @@ $(HsBindgen.Runtime.Prelude.addCSource (HsBindgen.Runtime.Prelude.unlines , "}" ])) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_0bdddf60550fc97b" thing_fun_1_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType ((Ptr.Ptr Thing) -> IO FC.CInt) + {-| Pointer-based API for 'thing_fun_1' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_1@ -} -foreign import ccall unsafe "hs_bindgen_0bdddf60550fc97b" thing_fun_1_wrapper :: +thing_fun_1_wrapper :: Ptr.Ptr Thing -> IO FC.CInt +thing_fun_1_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType thing_fun_1_wrapper_base {-| __C declaration:__ @thing_fun_1@ @@ -69,14 +77,21 @@ thing_fun_1 :: thing_fun_1 = \x0 -> F.with x0 (\y1 -> thing_fun_1_wrapper y1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_c293d866e22be6fc" thing_fun_2_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr Thing) -> IO ()) + {-| Pointer-based API for 'thing_fun_2' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_2@ -} -foreign import ccall unsafe "hs_bindgen_c293d866e22be6fc" thing_fun_2_wrapper :: +thing_fun_2_wrapper :: FC.CInt -> Ptr.Ptr Thing -> IO () +thing_fun_2_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType thing_fun_2_wrapper_base {-| __C declaration:__ @thing_fun_2@ @@ -94,16 +109,23 @@ thing_fun_2 = HsBindgen.Runtime.CAPI.allocaAndPeek (\z1 -> thing_fun_2_wrapper x0 z1) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_cfd51a9e490a997c" thing_fun_3a_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr Thing) -> FC.CDouble -> (Ptr.Ptr Thing) -> IO ()) + {-| Pointer-based API for 'thing_fun_3a' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3a@ -} -foreign import ccall unsafe "hs_bindgen_cfd51a9e490a997c" thing_fun_3a_wrapper :: +thing_fun_3a_wrapper :: FC.CInt -> Ptr.Ptr Thing -> FC.CDouble -> Ptr.Ptr Thing -> IO () +thing_fun_3a_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType thing_fun_3a_wrapper_base {-| __C declaration:__ @thing_fun_3a@ @@ -130,15 +152,22 @@ thing_fun_3a = HsBindgen.Runtime.CAPI.allocaAndPeek (\z4 -> thing_fun_3a_wrapper x0 y3 x2 z4)) +{-| This is an internal function. +-} +foreign import ccall unsafe "hs_bindgen_23fac8ee5044da6e" thing_fun_3b_wrapper_base :: + HsBindgen.Runtime.HasBaseForeignType.BaseForeignType (FC.CInt -> (Ptr.Ptr Thing) -> FC.CDouble -> IO FC.CChar) + {-| Pointer-based API for 'thing_fun_3b' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3b@ -} -foreign import ccall unsafe "hs_bindgen_23fac8ee5044da6e" thing_fun_3b_wrapper :: +thing_fun_3b_wrapper :: FC.CInt -> Ptr.Ptr Thing -> FC.CDouble -> IO FC.CChar +thing_fun_3b_wrapper = + HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType thing_fun_3b_wrapper_base {-| __C declaration:__ @thing_fun_3b@ diff --git a/hs-bindgen/fixtures/types/structs/struct_arg/th.txt b/hs-bindgen/fixtures/types/structs/struct_arg/th.txt index c2ef60028..74e19744d 100644 --- a/hs-bindgen/fixtures/types/structs/struct_arg/th.txt +++ b/hs-bindgen/fixtures/types/structs/struct_arg/th.txt @@ -129,12 +129,20 @@ instance HasCField Thing "thing_x" instance TyEq ty (CFieldType Thing "thing_x") => HasField "thing_x" (Ptr Thing) (Ptr ty) where getField = ptrToCField (Proxy @"thing_x") +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_4ad25504590fdd2b" thing_fun_1_wrapper_base :: BaseForeignType (Ptr Thing -> + IO CInt) {-| Pointer-based API for 'thing_fun_1' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_1@ -} -foreign import ccall safe "hs_bindgen_4ad25504590fdd2b" thing_fun_1_wrapper :: Ptr Thing -> - IO CInt +thing_fun_1_wrapper :: Ptr Thing -> IO CInt +{-| Pointer-based API for 'thing_fun_1' + +__unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_1@ +-} +thing_fun_1_wrapper = fromBaseForeignType thing_fun_1_wrapper_base {-| __C declaration:__ @thing_fun_1@ __defined at:__ @types\/structs\/struct_arg.h:6:5@ @@ -149,12 +157,21 @@ thing_fun_1 :: Thing -> IO CInt __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_1 = \x_0 -> with x_0 (\y_1 -> thing_fun_1_wrapper y_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_04a435522bf64978" thing_fun_2_wrapper_base :: BaseForeignType (CInt -> + Ptr Thing -> + IO Unit) {-| Pointer-based API for 'thing_fun_2' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_2@ -} -foreign import ccall safe "hs_bindgen_04a435522bf64978" thing_fun_2_wrapper :: CInt -> - Ptr Thing -> IO Unit +thing_fun_2_wrapper :: CInt -> Ptr Thing -> IO Unit +{-| Pointer-based API for 'thing_fun_2' + +__unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_2@ +-} +thing_fun_2_wrapper = fromBaseForeignType thing_fun_2_wrapper_base {-| __C declaration:__ @thing_fun_2@ __defined at:__ @types\/structs\/struct_arg.h:7:14@ @@ -169,14 +186,24 @@ thing_fun_2 :: CInt -> IO Thing __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_2 = \x_0 -> allocaAndPeek (\z_1 -> thing_fun_2_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5e3271324df7ced2" thing_fun_3a_wrapper_base :: BaseForeignType (CInt -> + Ptr Thing -> + CDouble -> + Ptr Thing -> + IO Unit) +{-| Pointer-based API for 'thing_fun_3a' + +__unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3a@ +-} +thing_fun_3a_wrapper :: CInt -> + Ptr Thing -> CDouble -> Ptr Thing -> IO Unit {-| Pointer-based API for 'thing_fun_3a' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3a@ -} -foreign import ccall safe "hs_bindgen_5e3271324df7ced2" thing_fun_3a_wrapper :: CInt -> - Ptr Thing -> - CDouble -> - Ptr Thing -> IO Unit +thing_fun_3a_wrapper = fromBaseForeignType thing_fun_3a_wrapper_base {-| __C declaration:__ @thing_fun_3a@ __defined at:__ @types\/structs\/struct_arg.h:9:14@ @@ -191,13 +218,22 @@ thing_fun_3a :: CInt -> Thing -> CDouble -> IO Thing __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_3a = \x_0 -> \x_1 -> \x_2 -> with x_1 (\y_3 -> allocaAndPeek (\z_4 -> thing_fun_3a_wrapper x_0 y_3 x_2 z_4)) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_3525c7d1c72f2fae" thing_fun_3b_wrapper_base :: BaseForeignType (CInt -> + Ptr Thing -> + CDouble -> + IO CChar) +{-| Pointer-based API for 'thing_fun_3b' + +__unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3b@ +-} +thing_fun_3b_wrapper :: CInt -> Ptr Thing -> CDouble -> IO CChar {-| Pointer-based API for 'thing_fun_3b' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3b@ -} -foreign import ccall safe "hs_bindgen_3525c7d1c72f2fae" thing_fun_3b_wrapper :: CInt -> - Ptr Thing -> - CDouble -> IO CChar +thing_fun_3b_wrapper = fromBaseForeignType thing_fun_3b_wrapper_base {-| __C declaration:__ @thing_fun_3b@ __defined at:__ @types\/structs\/struct_arg.h:10:6@ @@ -212,12 +248,20 @@ thing_fun_3b :: CInt -> Thing -> CDouble -> IO CChar __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_3b = \x_0 -> \x_1 -> \x_2 -> with x_1 (\y_3 -> thing_fun_3b_wrapper x_0 y_3 x_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_0bdddf60550fc97b" thing_fun_1_wrapper_base :: BaseForeignType (Ptr Thing -> + IO CInt) +{-| Pointer-based API for 'thing_fun_1' + +__unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_1@ +-} +thing_fun_1_wrapper :: Ptr Thing -> IO CInt {-| Pointer-based API for 'thing_fun_1' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_1@ -} -foreign import ccall safe "hs_bindgen_0bdddf60550fc97b" thing_fun_1_wrapper :: Ptr Thing -> - IO CInt +thing_fun_1_wrapper = fromBaseForeignType thing_fun_1_wrapper_base {-| __C declaration:__ @thing_fun_1@ __defined at:__ @types\/structs\/struct_arg.h:6:5@ @@ -232,12 +276,21 @@ thing_fun_1 :: Thing -> IO CInt __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_1 = \x_0 -> with x_0 (\y_1 -> thing_fun_1_wrapper y_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_c293d866e22be6fc" thing_fun_2_wrapper_base :: BaseForeignType (CInt -> + Ptr Thing -> + IO Unit) {-| Pointer-based API for 'thing_fun_2' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_2@ -} -foreign import ccall safe "hs_bindgen_c293d866e22be6fc" thing_fun_2_wrapper :: CInt -> - Ptr Thing -> IO Unit +thing_fun_2_wrapper :: CInt -> Ptr Thing -> IO Unit +{-| Pointer-based API for 'thing_fun_2' + +__unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_2@ +-} +thing_fun_2_wrapper = fromBaseForeignType thing_fun_2_wrapper_base {-| __C declaration:__ @thing_fun_2@ __defined at:__ @types\/structs\/struct_arg.h:7:14@ @@ -252,14 +305,24 @@ thing_fun_2 :: CInt -> IO Thing __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_2 = \x_0 -> allocaAndPeek (\z_1 -> thing_fun_2_wrapper x_0 z_1) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_cfd51a9e490a997c" thing_fun_3a_wrapper_base :: BaseForeignType (CInt -> + Ptr Thing -> + CDouble -> + Ptr Thing -> + IO Unit) {-| Pointer-based API for 'thing_fun_3a' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3a@ -} -foreign import ccall safe "hs_bindgen_cfd51a9e490a997c" thing_fun_3a_wrapper :: CInt -> - Ptr Thing -> - CDouble -> - Ptr Thing -> IO Unit +thing_fun_3a_wrapper :: CInt -> + Ptr Thing -> CDouble -> Ptr Thing -> IO Unit +{-| Pointer-based API for 'thing_fun_3a' + +__unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3a@ +-} +thing_fun_3a_wrapper = fromBaseForeignType thing_fun_3a_wrapper_base {-| __C declaration:__ @thing_fun_3a@ __defined at:__ @types\/structs\/struct_arg.h:9:14@ @@ -274,13 +337,22 @@ thing_fun_3a :: CInt -> Thing -> CDouble -> IO Thing __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_3a = \x_0 -> \x_1 -> \x_2 -> with x_1 (\y_3 -> allocaAndPeek (\z_4 -> thing_fun_3a_wrapper x_0 y_3 x_2 z_4)) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_23fac8ee5044da6e" thing_fun_3b_wrapper_base :: BaseForeignType (CInt -> + Ptr Thing -> + CDouble -> + IO CChar) +{-| Pointer-based API for 'thing_fun_3b' + +__unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3b@ +-} +thing_fun_3b_wrapper :: CInt -> Ptr Thing -> CDouble -> IO CChar {-| Pointer-based API for 'thing_fun_3b' __unique:__ @test_typesstructsstruct_arg_Example_Unsafe_thing_fun_3b@ -} -foreign import ccall safe "hs_bindgen_23fac8ee5044da6e" thing_fun_3b_wrapper :: CInt -> - Ptr Thing -> - CDouble -> IO CChar +thing_fun_3b_wrapper = fromBaseForeignType thing_fun_3b_wrapper_base {-| __C declaration:__ @thing_fun_3b@ __defined at:__ @types\/structs\/struct_arg.h:10:6@ @@ -295,10 +367,16 @@ thing_fun_3b :: CInt -> Thing -> CDouble -> IO CChar __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_3b = \x_0 -> \x_1 -> \x_2 -> with x_1 (\y_3 -> thing_fun_3b_wrapper x_0 y_3 x_2) +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_025103be0a357629" hs_bindgen_025103be0a357629_base :: BaseForeignType (IO (FunPtr (Thing -> + IO CInt))) +{-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_1_ptr@ +-} +hs_bindgen_025103be0a357629 :: IO (FunPtr (Thing -> IO CInt)) {-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_1_ptr@ -} -foreign import ccall safe "hs_bindgen_025103be0a357629" hs_bindgen_025103be0a357629 :: IO (FunPtr (Thing -> - IO CInt)) +hs_bindgen_025103be0a357629 = fromBaseForeignType hs_bindgen_025103be0a357629_base {-# NOINLINE thing_fun_1_ptr #-} {-| __C declaration:__ @thing_fun_1@ @@ -314,10 +392,16 @@ thing_fun_1_ptr :: FunPtr (Thing -> IO CInt) __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_1_ptr = unsafePerformIO hs_bindgen_025103be0a357629 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_e66f3bfa6ad4e4c8" hs_bindgen_e66f3bfa6ad4e4c8_base :: BaseForeignType (IO (FunPtr (CInt -> + IO Thing))) +{-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_2_ptr@ +-} +hs_bindgen_e66f3bfa6ad4e4c8 :: IO (FunPtr (CInt -> IO Thing)) {-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_2_ptr@ -} -foreign import ccall safe "hs_bindgen_e66f3bfa6ad4e4c8" hs_bindgen_e66f3bfa6ad4e4c8 :: IO (FunPtr (CInt -> - IO Thing)) +hs_bindgen_e66f3bfa6ad4e4c8 = fromBaseForeignType hs_bindgen_e66f3bfa6ad4e4c8_base {-# NOINLINE thing_fun_2_ptr #-} {-| __C declaration:__ @thing_fun_2@ @@ -333,12 +417,19 @@ thing_fun_2_ptr :: FunPtr (CInt -> IO Thing) __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_2_ptr = unsafePerformIO hs_bindgen_e66f3bfa6ad4e4c8 +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_5fea3576dcdc292f" hs_bindgen_5fea3576dcdc292f_base :: BaseForeignType (IO (FunPtr (CInt -> + Thing -> + CDouble -> + IO Thing))) +{-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_3a_ptr@ +-} +hs_bindgen_5fea3576dcdc292f :: IO (FunPtr (CInt -> + Thing -> CDouble -> IO Thing)) {-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_3a_ptr@ -} -foreign import ccall safe "hs_bindgen_5fea3576dcdc292f" hs_bindgen_5fea3576dcdc292f :: IO (FunPtr (CInt -> - Thing -> - CDouble -> - IO Thing)) +hs_bindgen_5fea3576dcdc292f = fromBaseForeignType hs_bindgen_5fea3576dcdc292f_base {-# NOINLINE thing_fun_3a_ptr #-} {-| __C declaration:__ @thing_fun_3a@ @@ -354,12 +445,19 @@ thing_fun_3a_ptr :: FunPtr (CInt -> Thing -> CDouble -> IO Thing) __exported by:__ @types\/structs\/struct_arg.h@ -} thing_fun_3a_ptr = unsafePerformIO hs_bindgen_5fea3576dcdc292f +{-| This is an internal function. +-} +foreign import ccall safe "hs_bindgen_8df67f0e3a4b504f" hs_bindgen_8df67f0e3a4b504f_base :: BaseForeignType (IO (FunPtr (CInt -> + Thing -> + CDouble -> + IO CChar))) +{-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_3b_ptr@ +-} +hs_bindgen_8df67f0e3a4b504f :: IO (FunPtr (CInt -> + Thing -> CDouble -> IO CChar)) {-| __unique:__ @test_typesstructsstruct_arg_Example_get_thing_fun_3b_ptr@ -} -foreign import ccall safe "hs_bindgen_8df67f0e3a4b504f" hs_bindgen_8df67f0e3a4b504f :: IO (FunPtr (CInt -> - Thing -> - CDouble -> - IO CChar)) +hs_bindgen_8df67f0e3a4b504f = fromBaseForeignType hs_bindgen_8df67f0e3a4b504f_base {-# NOINLINE thing_fun_3b_ptr #-} {-| __C declaration:__ @thing_fun_3b@ diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/AST/Type.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/AST/Type.hs index 3b4866cac..aa07f1baa 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/AST/Type.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/AST/Type.hs @@ -63,5 +63,6 @@ data HsType = | HsBlock HsType | HsComplexType HsPrimType | HsStrLit String + | HsBaseForeignType HsType deriving stock (Generic, Show, Eq) diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs index b1f4b3be4..b94dde1d6 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs @@ -167,17 +167,19 @@ generateDecs opts haddockConfig moduleName (C.Decl info kind spec) = typedefDecs opts haddockConfig info d spec C.DeclOpaque cNameKind -> withCategoryM BType $ opaqueDecs cNameKind haddockConfig info spec - C.DeclFunction f -> + C.DeclFunction f -> do + instsMap <- State.get let funDeclsWith safety = - functionDecs safety opts haddockConfig moduleName info f spec + functionDecs safety opts haddockConfig moduleName instsMap info f spec funType = (C.TypeFun (snd <$> C.functionArgs f) (C.functionRes f)) -- Declare a function pointer. We can pass this 'FunPtr' to C -- functions that take a function pointer of the appropriate type. funPtrDecls = fst $ - addressStubDecs opts haddockConfig moduleName info funType spec - in pure $ withCategory BSafe (funDeclsWith SHs.Safe) - ++ withCategory BUnsafe (funDeclsWith SHs.Unsafe) - ++ withCategory BFunPtr funPtrDecls + addressStubDecs opts haddockConfig moduleName instsMap info funType spec + safes = withCategory BSafe (funDeclsWith SHs.Safe) + unsafes = withCategory BUnsafe (funDeclsWith SHs.Unsafe) + funPtrs = withCategory BFunPtr funPtrDecls + pure $ safes ++ unsafes ++ funPtrs C.DeclMacro macro -> withCategoryM BType $ macroDecs opts haddockConfig info macro spec C.DeclGlobal ty -> @@ -1265,21 +1267,25 @@ functionDecs :: -> TranslationConfig -> HaddockConfig -> BaseModuleName + -> Hs.InstanceMap -> C.DeclInfo -> C.Function -> C.DeclSpec -> [Hs.Decl] -functionDecs safety opts haddockConfig moduleName info f _spec = concat [ - funDecls - , [ hsWrapperDeclFunction highlevelName importName res wrappedArgTypes wrapParsedArgs f mbWrapComment - | areFancy +functionDecs safety opts haddockConfig moduleName instsMap info f _spec = + concat [ + funDecls + , [ hsWrapperDeclFunction highlevelName importName res wrappedArgTypes wrapParsedArgs f mbWrapComment + | areFancy + ] ] - ] where areFancy = anyFancy (res : wrappedArgTypes) + funDecls :: [Hs.Decl] funDecls = HsFI.foreignImportDecs + instsMap importName (snd resType) (if areFancy then ffiParams else ffiParsedArgs) @@ -1499,7 +1505,7 @@ global opts haddockConfig moduleName instsMap info ty _spec stubDecs :: [Hs.Decl] pureStubName :: Hs.Name Hs.NsVar (stubDecs, pureStubName) = - addressStubDecs opts haddockConfig moduleName info ty _spec + addressStubDecs opts haddockConfig moduleName instsMap info ty _spec getConstGetterOfType :: C.Type -> [Hs.Decl] getConstGetterOfType t = constGetter (Type.topLevel t) instsMap info pureStubName @@ -1570,13 +1576,14 @@ addressStubDecs :: TranslationConfig -> HaddockConfig -> BaseModuleName + -> Hs.InstanceMap -> C.DeclInfo -- ^ The given declaration -> C.Type -- ^ The type of the given declaration -> C.DeclSpec -> ( [Hs.Decl] , Hs.Name 'Hs.NsVar ) -addressStubDecs opts haddockConfig moduleName info ty _spec = +addressStubDecs opts haddockConfig moduleName instsMap info ty _spec = (foreignImport ++ runnerDecls, runnerName) where -- *** Stub (impure) *** @@ -1624,6 +1631,7 @@ addressStubDecs opts haddockConfig moduleName info ty _spec = foreignImport :: [Hs.Decl] foreignImport = HsFI.foreignImportDecs + instsMap stubImportName stubImportType [] diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs index f73359835..7744f68a6 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ForeignImport.hs @@ -1,21 +1,25 @@ -- | Generate Haskell foreign imports (using the 'HasBaseForeignType' class) module HsBindgen.Backend.Hs.Translation.ForeignImport ( - foreignImportDecs + vanillaForeignImportDecs + , foreignImportDecs , hasBaseForeignTypeDecs ) where +import Data.Set qualified as Set + import HsBindgen.Backend.Hs.AST qualified as Hs import HsBindgen.Backend.Hs.AST.Type import HsBindgen.Backend.Hs.CallConv import HsBindgen.Backend.Hs.Haddock.Documentation qualified as HsDoc import HsBindgen.Backend.Hs.Origin qualified as Origin +import HsBindgen.Backend.Hs.Translation.Instances qualified as Hs import HsBindgen.Backend.SHs.AST +import HsBindgen.Errors (panicPure) import HsBindgen.Frontend.Naming qualified as C import HsBindgen.Imports -import HsBindgen.Language.Haskell import HsBindgen.Language.Haskell qualified as Hs -foreignImportDecs :: +vanillaForeignImportDecs :: Hs.Name 'Hs.NsVar -> HsType -> [Hs.FunctionParameter] @@ -25,12 +29,8 @@ foreignImportDecs :: -> Maybe HsDoc.Comment -> Safety -> [Hs.Decl] -foreignImportDecs name resultType parameters origName callConv origin comment safety = - [ Hs.DeclForeignImport foreignImportDecl ] - -- TODO: prevent the "newtype constructor not in scope" bug. See issue #1282. - where - foreignImportDecl :: Hs.ForeignImportDecl - foreignImportDecl = Hs.ForeignImportDecl +vanillaForeignImportDecs name resultType parameters origName callConv origin comment safety = + [ Hs.DeclForeignImport $ Hs.ForeignImportDecl { foreignImportName = name , foreignImportResultType = resultType , foreignImportParameters = parameters @@ -40,19 +40,74 @@ foreignImportDecs name resultType parameters origName callConv origin comment sa , foreignImportComment = comment , foreignImportSafety = safety } + ] + +foreignImportDecs :: + Hs.InstanceMap + -> Hs.Name 'Hs.NsVar + -> HsType + -> [Hs.FunctionParameter] + -> C.Name + -> CallConv + -> Origin.ForeignImport + -> Maybe HsDoc.Comment + -> Safety + -> [Hs.Decl] +foreignImportDecs instsMap name resultType parameters origName callConv origin comment safety + | Hs.HasBaseForeignType `elem` + Hs.getInstances instsMap Nothing (Set.singleton Hs.HasBaseForeignType) [hsFunType] + = [ Hs.DeclForeignImport foreignImportDecl + , Hs.DeclFunction funDecl + ] + | otherwise + = panicPure "Can not find an IsForeignType instance!" + where + hsFunType :: HsType + hsFunType = + foldr + (\arg rest -> Hs.HsFun (Hs.functionParameterType arg) rest) + resultType + parameters + + foreignImportDecl :: Hs.ForeignImportDecl + foreignImportDecl = Hs.ForeignImportDecl + { foreignImportName = name' + , foreignImportResultType = resultType' + , foreignImportParameters = parameters' + , foreignImportOrigName = origName + , foreignImportCallConv = callConv + , foreignImportOrigin = origin + , foreignImportComment = Just $ + HsDoc.title [ HsDoc.TextContent "This is an internal function." ] + , foreignImportSafety = safety + } + + name' = name <> "_base" + resultType' = HsBaseForeignType hsFunType + parameters' = [] + + funDecl :: Hs.FunctionDecl + funDecl = Hs.FunctionDecl + { functionDeclName = name + , functionDeclResultType = resultType + , functionDeclParameters = parameters + , functionDeclOrigin = origin + , functionDeclComment = comment + , functionDeclBody = EGlobal HasBaseForeignType_fromBaseForeignType `EApp` EFree name' + } hasBaseForeignTypeDecs :: - Set TypeClass + Set Hs.TypeClass -> Hs.Newtype -> [Hs.Decl] hasBaseForeignTypeDecs insts nt = - [mk | HasBaseForeignType `elem` insts] + [mk | Hs.HasBaseForeignType `elem` insts] where mk :: Hs.Decl mk = Hs.DeclDeriveInstance Hs.DeriveInstance { deriveInstanceStrategy = Hs.DeriveNewtype - , deriveInstanceClass = HasBaseForeignType + , deriveInstanceClass = Hs.HasBaseForeignType , deriveInstanceName = Hs.newtypeName nt , deriveInstanceComment = Nothing } diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs index 9ba91a1dc..11b9a7020 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/Instances.hs @@ -61,6 +61,7 @@ getInstances instanceMap name = aux aux (blockInsts /\ acc) (t:hsTypes) HsComplexType primType -> aux (acc /\ hsPrimTypeInsts primType) hsTypes HsStrLit{} -> Set.empty + HsBaseForeignType{} -> Set.empty (/\) :: Ord a => Set a -> Set a -> Set a (/\) = Set.intersection diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ToFromFunPtr.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ToFromFunPtr.hs index d3af4b289..abffd6832 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ToFromFunPtr.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation/ToFromFunPtr.hs @@ -83,7 +83,7 @@ instancesFor :: -> [Hs.Decl] instancesFor (nameTo, nameToComment) (nameFrom, nameFromComment) funC funHs = concat [ -- import for @ToFunPtr@ instance - HsFI.foreignImportDecs + HsFI.vanillaForeignImportDecs nameTo (HsIO (HsFunPtr funHs)) [wrapperParam funHs] @@ -94,7 +94,7 @@ instancesFor (nameTo, nameToComment) (nameFrom, nameFromComment) funC funHs = co SHs.Safe -- import for @FromFunPtr@ instance - , HsFI.foreignImportDecs + , HsFI.vanillaForeignImportDecs nameFrom funHs [wrapperParam $ HsFunPtr funHs] diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Names.hs b/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Names.hs index 3e2a9f517..77850a653 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Names.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Names.hs @@ -325,6 +325,8 @@ resolveGlobal = \case -- HasBaseForeignType HasBaseForeignType_class -> importQ ''HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType + HasBaseForeignType_BaseForeignType -> importQ ''HsBindgen.Runtime.HasBaseForeignType.BaseForeignType + HasBaseForeignType_fromBaseForeignType -> importQ 'HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType -- Unsafe IO_unsafePerformIO -> importQ 'System.IO.Unsafe.unsafePerformIO diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs index 1cdc0f5c0..ceebd5208 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs @@ -121,6 +121,8 @@ data Global = -- HasBaseForeignType | HasBaseForeignType_class + | HasBaseForeignType_BaseForeignType + | HasBaseForeignType_fromBaseForeignType -- Unsafe | IO_unsafePerformIO diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs index 056de2835..86c734421 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs @@ -248,6 +248,7 @@ translateType = \case Hs.HsBlock t -> TGlobal Block_type `TApp` translateType t Hs.HsComplexType t -> TApp (TGlobal ComplexType) (translateType (HsPrimType t)) Hs.HsStrLit s -> TStrLit s + Hs.HsBaseForeignType t -> TGlobal HasBaseForeignType_BaseForeignType `TApp` translateType t {------------------------------------------------------------------------------- 'Storable' diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/TH/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/TH/Translation.hs index 372fbbefb..39ab00814 100644 --- a/hs-bindgen/src-internal/HsBindgen/Backend/TH/Translation.hs +++ b/hs-bindgen/src-internal/HsBindgen/Backend/TH/Translation.hs @@ -139,6 +139,8 @@ mkGlobal = \case -- HasBaseForeignType HasBaseForeignType_class -> ''HsBindgen.Runtime.HasBaseForeignType.HasBaseForeignType + HasBaseForeignType_BaseForeignType -> ''HsBindgen.Runtime.HasBaseForeignType.BaseForeignType + HasBaseForeignType_fromBaseForeignType -> 'HsBindgen.Runtime.HasBaseForeignType.fromBaseForeignType -- Unsafe IO_unsafePerformIO -> 'System.IO.Unsafe.unsafePerformIO @@ -366,6 +368,8 @@ mkGlobalExpr n = case n of -- in definition order, no wildcards -- HasBaseForeignType HasBaseForeignType_class -> panicPure "class in expression" + HasBaseForeignType_BaseForeignType -> panicPure "type in expression" + HasBaseForeignType_fromBaseForeignType -> TH.varE name -- Unsafe IO_unsafePerformIO -> TH.varE name