From 74f3d2d34ad6f4284eb6058a055474cbd1d2daec Mon Sep 17 00:00:00 2001 From: sheaf Date: Mon, 12 Aug 2024 14:26:16 +0200 Subject: [PATCH] Add inline-c example This commit adds a worked example of `inline-c`. It is quite close to hand-written bindings, but it is syntactically convenient. Fixes #38 --- alternatives/README.md | 59 ++++++++++++++++ alternatives/cabal.project | 3 +- alternatives/experiment/inline-c/LICENSE | 29 ++++++++ .../inline-c/app/HsBindgenCExample.hs | 68 +++++++++++++++++++ alternatives/experiment/inline-c/app/Main.hs | 46 +++++++++++++ alternatives/experiment/inline-c/app/Types.hs | 47 +++++++++++++ .../experiment/inline-c/try-inline-c.cabal | 41 +++++++++++ 7 files changed, 292 insertions(+), 1 deletion(-) create mode 100644 alternatives/experiment/inline-c/LICENSE create mode 100644 alternatives/experiment/inline-c/app/HsBindgenCExample.hs create mode 100644 alternatives/experiment/inline-c/app/Main.hs create mode 100644 alternatives/experiment/inline-c/app/Types.hs create mode 100644 alternatives/experiment/inline-c/try-inline-c.cabal diff --git a/alternatives/README.md b/alternatives/README.md index a3915283..a109f642 100644 --- a/alternatives/README.md +++ b/alternatives/README.md @@ -126,6 +126,65 @@ at times, especially with cross compilation. See https://github.com/haskell/c2hs/wiki/User-Guide for more information. +## `inline-c` + +The [`inline-c` library](https://hackage.haskell.org/package/inline-c) can be +used to manually write bindings to a C library. This is mostly a syntactic +convenience; under the hood, the library uses Template Haskell to generate +foreign import declarations. + +For example, code of the form + +```hs +import qualified Language.C.Inline as C +import MyLibContext( myLibCtxt ) + +C.include "myLib.h" +C.context myLibCtxt + +myFunction :: CInt -> HsEnum -> IO HsStruct +myFunction i f = + [|C.exp| CStruct* { myCFunction($(int i), $(CEnum f)) } |] +``` + +will generate a foreign import + +```hs +foreign import safe + inline_c_internal_id_1 :: CInt -> CEnum -> IO (Ptr CStruct) +``` + +as well as a `.c` file of the form + +```c +#include "myLib.h" + +CStruct* inline_c_internal_id_1 (int i, CEnum s) { + myCFunction(i, s); +} +``` + +Here `myLibCtxt` specifies how Haskell and C types are interconverted: + +```hs +module MyLibContext where + +import qualified Language.C.Inline as C + +data HsEnum = ... +instance Storable HsEnum +data HsStruct = ... +instance Storable HsStruct + +myLibCtxt :: C.Context +myLibCtxt = mempty + { C.ctxtTypesTables = Map.fromList + [ ( C.TypeName "CEnum" , [t| HsEnum |] ) + , ( C.TypeName "CStruct", [t| HsStruct |] ) + ] + } +``` + ## `cgen` TODO diff --git a/alternatives/cabal.project b/alternatives/cabal.project index defcd159..d0430d3e 100644 --- a/alternatives/cabal.project +++ b/alternatives/cabal.project @@ -1,5 +1,6 @@ -packages: +packages: experiment/manual + experiment/inline-c experiment/hsc2hs experiment/c2hs tools/hsc2hs diff --git a/alternatives/experiment/inline-c/LICENSE b/alternatives/experiment/inline-c/LICENSE new file mode 100644 index 00000000..0cb6e3c8 --- /dev/null +++ b/alternatives/experiment/inline-c/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2024, Well-Typed LLP and Anduril Industries Inc. + + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/alternatives/experiment/inline-c/app/HsBindgenCExample.hs b/alternatives/experiment/inline-c/app/HsBindgenCExample.hs new file mode 100644 index 00000000..ade2cae5 --- /dev/null +++ b/alternatives/experiment/inline-c/app/HsBindgenCExample.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | Handwritten bindings, using inline-c. +module HsBindgenCExample where + +-- base +import Foreign +import Foreign.C.Types + +-- inline-c +import qualified Language.C.Inline as C + +-- try-inline-c +import Types + +-------------------------------------------------------------------------------- + +C.context (C.baseCtx <> C.funCtx <> exampleContext) +C.include "hs-bindgen-c-example.h" + +{------------------------------------------------------------------------------- + Valid declarations +-------------------------------------------------------------------------------} + +cHelloWorld :: IO () +cHelloWorld = [C.exp| void { hs_bindgen_c_example_helloworld(); } |] + +cShowInt :: CInt -> IO () +cShowInt i = + [C.exp| void { hs_bindgen_c_example_showInt($(int i)); } |] + +cShowStruct :: Ptr HaskellStruct -> IO () +cShowStruct str = + [C.exp| void { hs_bindgen_c_example_showStruct($(ExampleStruct* str)); }|] + +cCallFunPtr :: FunPtr_Void_Int -> IO () +cCallFunPtr ptr = + [C.exp| void { hs_bindgen_c_example_callFunPtr($(FunPtr_Void_Int ptr)); } |] + +addrOf_cShowInt :: IO FunPtr_Void_Int +addrOf_cShowInt = + [C.exp| FunPtr_Void_Int { &hs_bindgen_c_example_showInt } |] + +cReturnFunPtr :: IO FunPtr_Void_Int +cReturnFunPtr = + [C.exp| FunPtr_Void_Int { hs_bindgen_c_example_returnFunPtr() } |] + +callFunPtr_Void_Int :: FunPtr_Void_Int -> CInt -> IO () +callFunPtr_Void_Int ptr i = + [C.exp| void { $(FunPtr_Void_Int ptr)($(int i)) } |] + +wrapFunPtr_Void_Int :: (CInt -> IO ()) -> IO FunPtr_Void_Int +wrapFunPtr_Void_Int f = + [C.exp| void (*)(int) { $fun:(void (*f)(int)) } |] + +{------------------------------------------------------------------------------- + Invalid declarations +-------------------------------------------------------------------------------} + +#ifdef INCLUDE_INVALID + +invalid_cShowInt_wrongParam :: Ptr CInt -> IO () +invalid_cShowInt_wrongParam i + = [C.exp| void { hs_bindgen_c_example_showInt($(int i)) } |] + +#endif diff --git a/alternatives/experiment/inline-c/app/Main.hs b/alternatives/experiment/inline-c/app/Main.hs new file mode 100644 index 00000000..ea9afdcb --- /dev/null +++ b/alternatives/experiment/inline-c/app/Main.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE CPP #-} + +module Main (main) where + +-- base +import Foreign +import System.IO + +-- try-inline-c +import Types +import HsBindgenCExample + +-------------------------------------------------------------------------------- + +main :: IO () +main = do + hSetBuffering stdout NoBuffering + + -- Simplest example: call C function with no arguments, no result + cHelloWorld + + -- C function with a single argument + cShowInt 1234 + + -- C function taking a pointer to a struct as argument + alloca $ \ptr -> do + poke ptr $ HaskellStruct 1234 5678 + cShowStruct ptr + + -- C function taking a pointer to a function, passing another C function + addr <- addrOf_cShowInt + cCallFunPtr addr + + -- C function returning a pointer to a function, executing it in Haskell + funPtrFromC <- cReturnFunPtr + callFunPtr_Void_Int funPtrFromC 12345678 + + -- C function taking a pointer to a function, passing a Haskell function + funPtrFromHaskell <- wrapFunPtr_Void_Int $ \x -> + putStrLn $ "fromHaskell: " ++ show x + cCallFunPtr funPtrFromHaskell + +#ifdef INCLUDE_INVALID + alloca $ \ptr -> + invalid_cShowInt_wrongParam ptr +#endif diff --git a/alternatives/experiment/inline-c/app/Types.hs b/alternatives/experiment/inline-c/app/Types.hs new file mode 100644 index 00000000..1cd52781 --- /dev/null +++ b/alternatives/experiment/inline-c/app/Types.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskellQuotes #-} + +module Types where + +-- base +import Foreign +import Foreign.C.Types + +-- containers +import qualified Data.Map as Map + +-- inline-c +import qualified Language.C.Inline.Context as C +import qualified Language.C.Types as C + +{------------------------------------------------------------------------------- + Context +-------------------------------------------------------------------------------} + +type FunPtr_Void_Int = FunPtr (CInt -> IO ()) + +data HaskellStruct = HaskellStruct { + haskellStructA :: CInt + , haskellStructB :: CInt + } + +instance Storable HaskellStruct where + sizeOf _ = 8 + alignment _ = 4 + + peek s = do + haskellStructA <- peekByteOff s 0 + haskellStructB <- peekByteOff s 4 + return HaskellStruct{haskellStructA, haskellStructB} + + poke s HaskellStruct{haskellStructA, haskellStructB} = do + pokeByteOff s 0 haskellStructA + pokeByteOff s 4 haskellStructB + +exampleContext :: C.Context +exampleContext = mempty + { C.ctxTypesTable = Map.fromList + [ ( C.TypeName "ExampleStruct" , [t| HaskellStruct |] ) + , ( C.TypeName "FunPtr_Void_Int", [t| FunPtr_Void_Int |] ) + ] + } diff --git a/alternatives/experiment/inline-c/try-inline-c.cabal b/alternatives/experiment/inline-c/try-inline-c.cabal new file mode 100644 index 00000000..246a68bb --- /dev/null +++ b/alternatives/experiment/inline-c/try-inline-c.cabal @@ -0,0 +1,41 @@ +cabal-version: 3.0 +name: try-inline-c +version: 0.1.0 +license: BSD-3-Clause +license-file: LICENSE +author: Edsko de Vries +maintainer: edsko@well-typed.com +build-type: Simple + +common lang + ghc-options: + -Wall + build-depends: + base >= 4.16 + , containers >= 0.5 && < 0.8 + default-language: + GHC2021 + +executable try-inline-c + import: + lang + hs-source-dirs: + app + main-is: + Main.hs + other-modules: + HsBindgenCExample + Types + build-depends: + inline-c ^>= 0.9 + --pkgconfig-depends: + -- hs-bindgen-c-example + + if(flag(include-invalid)) + cpp-options: + -DINCLUDE_INVALID + +flag include-invalid + description: Also include invalid declarations + default: False + manual: True \ No newline at end of file