language-c-inline 0.7.9.2 → 0.7.10.0
raw patch · 7 files changed
+154/−50 lines, 7 files
Files
- Language/C/Inline/Hint.hs +20/−11
- Language/C/Inline/ObjC.hs +34/−9
- Language/C/Inline/ObjC/Hint.hs +35/−3
- Language/C/Inline/ObjC/Marshal.hs +49/−17
- Language/C/Inline/State.hs +8/−7
- Language/C/Inline/TH.hs +4/−1
- language-c-inline.cabal +4/−2
Language/C/Inline/Hint.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Language.C.Inline.Hint--- Copyright : [2013..2014] Manuel M T Chakravarty+-- Copyright : [2013..2016] Manuel M T Chakravarty -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@justtesting.org>@@ -19,7 +19,7 @@ Hint(..), -- * Querying of annotated entities- haskellTypeOf, foreignTypeOf, stripAnnotation+ haskellTypeOf, foreignTypeOf, newForeignPtrOf, stripAnnotation ) where -- common libraries@@ -62,19 +62,22 @@ -- |Hints imply marshalling strategies, which include source and destination types for marshalling. -- class Hint hint where- haskellType :: hint -> Q TH.Type- foreignType :: hint -> Q (Maybe QC.Type) -- ^In case of 'Nothing', the foreign type is determined by the Haskell type.- showQ :: hint -> Q String+ haskellType :: hint -> Q TH.Type+ foreignType :: hint -> Q (Maybe QC.Type) -- ^In case of 'Nothing', the foreign type is determined by the Haskell type.+ showQ :: hint -> Q String+ newForeignPtrName :: hint -> Q (Maybe TH.Name) instance Hint Name where -- must be a type name- haskellType = conT- foreignType = const (return Nothing)- showQ = return . show+ haskellType = conT+ foreignType = const (return Nothing)+ showQ = return . show+ newForeignPtrName = const (return Nothing) instance Hint (Q TH.Type) where- haskellType = id- foreignType = const (return Nothing)- showQ = (show <$>)+ haskellType = id+ foreignType = const (return Nothing)+ showQ = (show <$>)+ newForeignPtrName = const (return Nothing) -- |Determine the Haskell type implied for the given annotated entity. --@@ -99,6 +102,12 @@ foreignTypeOf :: Annotated e -> Q (Maybe QC.Type) foreignTypeOf (_ :> hint) = foreignType hint foreignTypeOf (Typed name) = return Nothing++-- |Determine the name of the function to create a new foreign pointer for this type if any.+--+newForeignPtrOf :: Annotated e -> Q (Maybe TH.Name)+newForeignPtrOf (_ :> hint) = newForeignPtrName hint+newForeignPtrOf (Typed name) = return Nothing -- |Remove the annotation. --
Language/C/Inline/ObjC.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Language.C.Inline.ObjC--- Copyright : [2013] Manuel M T Chakravarty+-- Copyright : [2013..2016] Manuel M T Chakravarty -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -15,15 +15,19 @@ -- * Re-export types from 'Foreign.C' module Foreign.C.Types, CString, CStringLen, CWString, CWStringLen, Errno, ForeignPtr, castForeignPtr,-+ -- * Re-export types from Template Haskell Name, + -- * Objective-C memory management support+ objc_retain, objc_release, objc_release_ptr, newForeignClassPtr, newForeignStructPtr,+ -- * Combinators for inline Objective-C - objc_import, objc_interface, objc_implementation, objc_record, objc_marshaller, objc_typecheck, objc, objc_emit,+ objc_import, objc_interface, objc_implementation, objc_record, objc_marshaller, objc_class_marshaller, + objc_struct_marshaller, objc_typecheck, objc, objc_emit, -- * Marshalling annotations- Annotated(..), (<:), void, Class(..), IsType,+ Annotated(..), (<:), void, Class(..), Struct(..), IsType, -- * Property maps PropertyAccess, (==>), (-->)@@ -62,6 +66,9 @@ import Language.C.Inline.ObjC.Marshal +-- Combinators for inline Objective-C +-- ----------------------------------+ -- |Specify imported Objective-C files. Needs to be spliced where an import declaration can appear. (Just put it -- straight after all the import statements in the module.) --@@ -133,7 +140,7 @@ { -- Determine the bridging type and the marshalling code ; (bridgeArgTys, cBridgeArgTys, hsArgMarshallers, cArgMarshallers) <-- unzip4 <$> zipWithM generateCToHaskellMarshaller argTys cArgTys+ unzip4 <$> zipWithM (generateCToHaskellMarshaller Nothing) argTys cArgTys ; (bridgeResTy, cBridgeResTy, hsResMarshaller, cResMarshaller) <- generateHaskellToCMarshaller resTy cResTy -- Haskell type of the foreign wrapper function@@ -378,13 +385,30 @@ where propTy = QC.Type spec decl loc +-- |Deprecated: use 'objc_class_marshaller' or 'objc_struct_marshaller' instead+--+objc_marshaller :: TH.Name -> TH.Name -> Q [TH.Dec]+{-# DEPRECATED objc_marshaller "use 'objc_class_marshaller' or 'objc_struct_marshaller' instead" #-}+objc_marshaller = objc_class_marshaller+ -- |Declare a Haskell<->Objective-C marshaller pair to be used in all subsequent marshalling code generation. -- -- On the Objective-C side, the marshallers must use a wrapped foreign pointer to an Objective-C class (just as those -- of 'Class' hints). The domain and codomain of the two marshallers must be the opposite and both are executing in 'IO'. ---objc_marshaller :: TH.Name -> TH.Name -> Q [TH.Dec]-objc_marshaller haskellToObjCName objcToHaskellName+objc_class_marshaller :: TH.Name -> TH.Name -> Q [TH.Dec]+objc_class_marshaller = objc_marshaller' 'newForeignClassPtr++-- |Declare a Haskell<->Objective-C marshaller pair to be used in all subsequent marshalling code generation.+--+-- On the Objective-C side, the marshallers must use a wrapped foreign pointer to an C struct (just as those+-- of 'Struct' hints). The domain and codomain of the two marshallers must be the opposite and both are executing in 'IO'.+--+objc_struct_marshaller :: TH.Name -> TH.Name -> Q [TH.Dec]+objc_struct_marshaller = objc_marshaller' 'newForeignStructPtr++objc_marshaller' :: TH.Name -> TH.Name -> TH.Name -> Q [TH.Dec]+objc_marshaller' newForeignPtrFun haskellToObjCName objcToHaskellName = do { -- check that the marshallers have compatible types ; (hsTy1, classTy1) <- argAndResultTy haskellToObjCName@@ -395,7 +419,7 @@ ; tyconName <- headTyConNameOrError QC.ObjC classTy1 ; let cTy = [cty| typename $id:(nameBase tyconName) * |]- ; stashMarshaller (hsTy1, classTy1, cTy, haskellToObjCName, objcToHaskellName)+ ; stashMarshaller (hsTy1, classTy1, cTy, haskellToObjCName, objcToHaskellName, newForeignPtrFun) ; return [] } where@@ -425,6 +449,7 @@ ; let vars = map stripAnnotation ann_vars ; varTys <- mapM haskellTypeOf ann_vars ; resTy <- haskellTypeOf ann_e+ ; newFP <- newForeignPtrOf ann_e -- Determine C types ; maybe_cArgTys <- mapM annotatedHaskellTypeToCType ann_vars@@ -441,7 +466,7 @@ ; (bridgeArgTys, cBridgeArgTys, hsArgMarshallers, cArgMarshallers) <- unzip4 <$> zipWithM generateHaskellToCMarshaller varTys cArgTys ; (bridgeResTy, cBridgeResTy, hsResMarshaller, cResMarshaller) <-- generateCToHaskellMarshaller resTy cResTy+ generateCToHaskellMarshaller newFP resTy cResTy -- Haskell type of the foreign wrapper function ; let hsWrapperTy = haskellWrapperType [] bridgeArgTys bridgeResTy
Language/C/Inline/ObjC/Hint.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Language.C.Inline.ObjC.Hint--- Copyright : 2014 Manuel M T Chakravarty+-- Copyright : [2014..2016] Manuel M T Chakravarty -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@justtesting.org>@@ -12,8 +12,8 @@ -- This module provides Objective-C specific hints. module Language.C.Inline.ObjC.Hint (- -- * Class hints- Class(..), IsType+ -- * Class and Struct hints+ Class(..), Struct(..), IsType ) where -- standard libraries@@ -28,6 +28,7 @@ import Language.C.Inline.Error import Language.C.Inline.Hint import Language.C.Inline.TH+import Language.C.Inline.ObjC.Marshal -- |Class of entities that can be used as TH types.@@ -80,3 +81,34 @@ { ty <- theType tyish ; return $ "Class " ++ show ty }+ newForeignPtrName (Class _)+ = return $ Just 'newForeignClassPtr++-- |Hint indicating to marshal a pointer to a C struct as a foreign pointer, where the argument is the Haskell type+-- representing the C type name. The Haskell type name must coincide with the C type name.+--+-- NB: This is like `Class` with the difference that finalisers on foreign pointers created during marshalling use+-- 'free' rather than 'release'.+--+data Struct where+ Struct :: IsType t => t -> Struct++instance Hint Struct where+ haskellType (Struct tyish) + = do+ { ty <- theType tyish+ ; foreignWrapperDatacon ty -- FAILS if the declaration is not a 'ForeignPtr' wrapper+ ; return ty+ }+ foreignType (Struct tyish)+ = do+ { name <- theType tyish >>= headTyConNameOrError QC.ObjC+ ; return $ Just [cty| typename $id:(nameBase name) * |]+ }+ showQ (Struct tyish) + = do+ { ty <- theType tyish+ ; return $ "Struct " ++ show ty+ }+ newForeignPtrName (Struct _)+ = return $ Just 'newForeignStructPtr
Language/C/Inline/ObjC/Marshal.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE PatternGuards, TemplateHaskell, QuasiQuotes #-}+{-# LANGUAGE PatternGuards, TemplateHaskell, QuasiQuotes, ForeignFunctionInterface #-} -- | -- Module : Language.C.Inline.ObjC.Marshal--- Copyright : [2013] Manuel M T Chakravarty+-- Copyright : [2013..2016] Manuel M T Chakravarty -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -14,6 +14,10 @@ -- FIXME: Some of the code can go into a module for general marshalling, as only some of it is ObjC-specific. module Language.C.Inline.ObjC.Marshal (++ -- * Objective-C memory management support+ objc_retain, objc_release, objc_release_ptr, newForeignClassPtr, newForeignStructPtr,+ -- * Determine corresponding foreign types of Haskell types haskellTypeToCType, @@ -48,6 +52,27 @@ import Language.C.Inline.TH +-- Objective-C memory management support from the Objective-C runtime+-- ------------------------------------------------------------------++foreign import ccall "objc_retain" objc_retain :: C.Ptr a -> IO (C.Ptr a)+foreign import ccall "objc_release" objc_release :: C.Ptr a -> IO ()+foreign import ccall "&objc_release" objc_release_ptr :: C.FunPtr (C.Ptr a -> IO ())++-- |Turn a retainable Objective-C pointer into a foreign pointer that is released when finalised.+--+-- NB: We need to retain the pointer first as it won't come with a +1 retain count for Haskell land to consume+-- (at best, it will have an autoreleased +1 if it is a function return result).+--+newForeignClassPtr :: C.Ptr a -> IO (C.ForeignPtr a)+newForeignClassPtr ptr = objc_retain ptr >>= newForeignPtr objc_release_ptr++-- |Turn a non-retainable C pointer into a foreign pointer that is freed when finalised.+--+newForeignStructPtr :: C.Ptr a -> IO (C.ForeignPtr a)+newForeignStructPtr ptr = newForeignPtr finalizerFree ptr++ -- Determine foreign types -- ----------------------- @@ -60,8 +85,8 @@ = do { maybe_marshaller <- lookupMarshaller ty ; case maybe_marshaller of- Just (_, _, cTy, _, _) -> return $ Just cTy -- use a custom marshaller if one is available for this type- Nothing -> haskellTypeToCType' lang ty -- otherwise, continue below...+ Just (_, _, cTy, _, _, _) -> return $ Just cTy -- use a custom marshaller if one is available for this type+ Nothing -> haskellTypeToCType' lang ty -- otherwise, continue below... } where haskellTypeToCType' lang (ListT `AppT` (ConT char)) -- marshal '[Char]' as 'String'@@ -200,8 +225,8 @@ = do { maybe_marshaller <- lookupMarshaller hsTy ; case maybe_marshaller of- Just (_, classTy, cTy', haskellToC, _cToHaskell)- | cTy' == cTy -- custom marshaller mapping to an Objective-C class+ Just (_, classTy, cTy', haskellToC, _cToHaskell, _newForeignPtr) + | cTy' == cTy -- custom marshaller mapping to an Objective-C class or struct -> return ( ptrOfForeignPtrWrapper classTy , cTy , \val cont -> [| do@@ -299,6 +324,9 @@ -- |Generate the type-specific marshalling code for Haskell to C land marshalling for a C-Haskell type pair. --+-- The first argument is a function to turn a pointer into a foreign pointer in the case where an explicit 'Class' or+-- 'Struct' hint was provided.+-- -- The result has the following components: -- -- * Haskell type after Haskell-side marshalling.@@ -306,27 +334,33 @@ -- * Generator for the Haskell-side marshalling code. -- * Generator for the C-side marshalling code. ---generateCToHaskellMarshaller :: TH.Type -> QC.Type -> Q (TH.TypeQ, QC.Type, HaskellMarshaller, CMarshaller)-generateCToHaskellMarshaller hsTy cTy@(Type (DeclSpec _ _ (Tnamed (Id name _) _ _) _) (Ptr _ (DeclRoot _) _) _)+generateCToHaskellMarshaller :: Maybe TH.Name -> TH.Type -> QC.Type -> Q (TH.TypeQ, QC.Type, HaskellMarshaller, CMarshaller)+generateCToHaskellMarshaller (Just newForeignPtr)+ hsTy + cTy@(Type (DeclSpec _ _ (Tnamed (Id name _) _ _) _) (Ptr _ (DeclRoot _) _) _) | Just name == maybeHeadName -- ForeignPtr mapped to an Objective-C class = return ( ptrOfForeignPtrWrapper hsTy , cTy , \val cont -> do { let datacon = foreignWrapperDatacon hsTy- ; [| do { fptr <- newForeignPtr_ $val; $cont ($datacon fptr) } |] + ; [| do { fptr <- $(varE newForeignPtr) $val; $cont ($datacon fptr) } |] } , \argName -> [cexp| $id:(show argName) |] )- | otherwise+ where+ maybeHeadName = fmap nameBase $ headTyConName hsTy+generateCToHaskellMarshaller Nothing+ hsTy + cTy = do { maybe_marshaller <- lookupMarshaller hsTy ; case maybe_marshaller of- Just (_, classTy, cTy', _haskellToC, cToHaskell)- | cTy' == cTy -- custom marshaller mapping to an Objective-C class+ Just (_, classTy, cTy', _haskellToC, cToHaskell, newForeignPtr)+ | cTy' == cTy -- custom marshaller mapping to an Objective-C class or struct -> return ( ptrOfForeignPtrWrapper classTy , cTy , \val cont -> do { let datacon = foreignWrapperDatacon classTy ; [| do - { fptr <- newForeignPtr_ $val+ { fptr <- $(varE newForeignPtr) $val ; hsVal <- $(varE cToHaskell) ($datacon fptr) ; $cont hsVal } |] @@ -336,15 +370,13 @@ Nothing -- other => continue below -> generateCToHaskellMarshaller' hsTy cTy }- where- maybeHeadName = fmap nameBase $ headTyConName hsTy-generateCToHaskellMarshaller hsTy cTy = generateCToHaskellMarshaller' hsTy cTy+generateCToHaskellMarshaller _ hsTy cTy = generateCToHaskellMarshaller' hsTy cTy generateCToHaskellMarshaller' :: TH.Type -> QC.Type -> Q (TH.TypeQ, QC.Type, HaskellMarshaller, CMarshaller) generateCToHaskellMarshaller' hsTy@(ConT maybe `AppT` argTy) cTy | maybe == ''Maybe && isCPtrType cTy = do - { (argTy', cTy', hsMarsh, cMarsh) <- generateCToHaskellMarshaller argTy cTy+ { (argTy', cTy', hsMarsh, cMarsh) <- generateCToHaskellMarshaller Nothing argTy cTy ; ty <- argTy' ; resolve ty argTy' cTy' hsMarsh cMarsh }
Language/C/Inline/State.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Language.C.Inline.State--- Copyright : [2013] Manuel M T Chakravarty+-- Copyright : [2013..2016] Manuel M T Chakravarty -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -34,11 +34,12 @@ import Language.C.Quote as QC -type CustomMarshaller = ( TH.Type -- Haskell type- , TH.Type -- Haskell-side class type- , QC.Type -- C type- , TH.Name -- Haskell->C marshaller function- , TH.Name) -- C->Haskell marshaller function+type CustomMarshaller = ( TH.Type -- Haskell type+ , TH.Type -- Haskell-side class type+ , QC.Type -- C type+ , TH.Name -- Haskell->C marshaller function+ , TH.Name -- C->Haskell marshaller function+ , TH.Name) -- C->Haskell pointer marshalling data State = State@@ -123,7 +124,7 @@ lookupMarshaller ty = do { marshallers <- getMarshallers- ; case filter (\(hsTy, _, _, _, _) -> hsTy == ty) marshallers of+ ; case filter (\(hsTy, _, _, _, _, _) -> hsTy == ty) marshallers of [] -> return Nothing marshaller:_ -> return $ Just marshaller }
Language/C/Inline/TH.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Language.C.Inline.TH--- Copyright : 2014 Manuel M T Chakravarty+-- Copyright : [2014..2016] Manuel M T Chakravarty -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@justtesting.org>@@ -17,6 +17,7 @@ -- * Decompose idiomatic declarations foreignWrapperDatacon, ptrOfForeignPtrWrapper, unwrapForeignPtrWrapper+ ) where -- standard libraries@@ -24,9 +25,11 @@ import Foreign.Ptr import Foreign.ForeignPtr import Language.Haskell.TH as TH+import Language.Haskell.TH.Quote as TH import Language.Haskell.TH.Syntax as TH -- quasi-quotation libraries+import Language.C.Parser as QC import Language.C.Quote as QC -- friends
language-c-inline.cabal view
@@ -1,7 +1,7 @@ Name: language-c-inline-Version: 0.7.9.2+Version: 0.7.10.0 Cabal-version: >= 1.9.2-Tested-with: GHC == 7.10.2+Tested-with: GHC == 7.10.3 Build-type: Simple Synopsis: Inline C & Objective-C code in Haskell for language interoperability@@ -15,6 +15,8 @@ For more information, see <https://github.com/mchakravarty/language-c-inline/wiki>. . Known bugs: <https://github.com/mchakravarty/language-c-inline/issues>+ .+ * New in 0.7.10: Distinction between 'Class' (NSObject pointers) and 'Struct' (C pointers) in both hints and marhsallers. . * New in 0.7.9: C wrapper names include the filename to disambiguate linker symbols. .