-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #486 from well-typed/userland-capi
Add userland-capi PoC
- Loading branch information
Showing
9 changed files
with
293 additions
and
19 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,64 @@ | ||
| # Userland CAPI | ||
|
|
||
| Originally CApiFFI was created to solve a convenience problem with `iconv` foreign imports: | ||
| https://gitlab.haskell.org/ghc/ghc/-/issues/2979 | ||
|
|
||
| An important point made already then, is that when creating trivial wrappers, | ||
| we need at least to try to make their names unique enough, so the C names won't clash | ||
| with some other wrappers. (FWIW, that can easily become issue with names like `hs_sha256_update`!) | ||
|
|
||
| Maybe more as a side-effect `CApiFFI` also enabled "type-checking" of C-imports, | ||
| as there is a true C code using them compiled with C-compiler, not just linking (which only checked that symbol exists). | ||
|
|
||
| However, `CApiFFI` may be considered partial feature. A C-file for wrappers is created, but as programmers we have very limited tools to affect it. | ||
| We *could* make an include file with some trivial import, and that way "splice" some contents into the wrapper C file; | ||
| the cost is the need to create an extra source file. | ||
|
|
||
| Some time later GHC TH got ability to add arbitrary | ||
| code to be compiled and linked together with a module: | ||
| [addForeignSource](https://hackage.haskell.org/package/template-haskell-2.22.0.0/docs/Language-Haskell-TH-Syntax.html#v:addForeignSource). | ||
|
|
||
| `addForeignSource` allows to do the same things `CApiFFI` does: | ||
|
|
||
| With `CApiFFI` we do | ||
|
|
||
| ```haskell | ||
| -- we can use CApiFFI to import printf with some fixed signature | ||
| foreign import capi "stdio.h printf" my_printf :: CString -> CInt -> IO () | ||
| ``` | ||
|
|
||
| but we can also do | ||
|
|
||
| ```haskell | ||
| -- or we can create wrapper ourselves, all from Haskell source: | ||
| $(do | ||
| addForeignSource LangC $ unlines | ||
| [ "#include <stdio.h>" | ||
| , "void printf_wrapper(const char *fmt, int x) { printf(fmt, x); }" | ||
| ] | ||
|
|
||
| [d| | ||
| foreign import ccall "printf_wrapper" my_printf2 :: CString -> CInt -> IO () | ||
| |]) | ||
| ``` | ||
|
|
||
| Obviously the latter is more verbose, as we do everything ourselves. | ||
| But we can imagine a small library allowing to make imports (and their wrappers) in more concise way. | ||
|
|
||
| A first step could be | ||
|
|
||
| ```haskell | ||
| $(userlandCApi 'localname $ do | ||
| addInclude "<stdio.h>" | ||
| w <- freshCName "printf" | ||
| addC $ "void " ++ w ++ "(const char *fmt, int x) { printf(fmt, x); }" | ||
| addDec $ foreignImport w "my_printf2" [t| CString -> CInt -> IO () |]) | ||
| ``` | ||
|
|
||
| here we use `'localname` to give generator a module unique identifier (unit id together with module name), | ||
| from which it can generate unique(-enough) wrapper names. | ||
|
|
||
| We can also imagine further adding some utilties to declare C and Hs types simultaneously. | ||
|
|
||
| This approach allows to create more elaborate C wrappers (and why not wrappers on Haskell side). | ||
| The cost is that approach is not as integrated. `CType` annotations are not reifiable, so we'd need to teach the library that `CInt` is `int` etc. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,26 @@ | ||
| {-# LANGUAGE CApiFFI #-} | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
| module Main (main) where | ||
|
|
||
| import Foreign.C.String (CString, withCString) | ||
| import Foreign.C.Types (CInt (..)) | ||
| import Language.Haskell.TH.Syntax (ForeignSrcLang (LangC), addForeignSource) | ||
|
|
||
| -- we can use CApiFFI to import printf with some fixed signature | ||
| foreign import capi "stdio.h printf" my_printf :: CString -> CInt -> IO () | ||
|
|
||
| -- or we can create wrapper ourselves, all from Haskell source: | ||
| $(do | ||
| addForeignSource LangC $ unlines | ||
| [ "#include <stdio.h>" | ||
| , "void printf_wrapper(const char *fmt, int x) { printf(fmt, x); }" | ||
| ] | ||
|
|
||
| [d| | ||
| foreign import ccall "printf_wrapper" my_printf2 :: CString -> CInt -> IO () | ||
| |]) | ||
|
|
||
| main :: IO () | ||
| main = do | ||
| withCString "hello %d\n" $ \str -> my_printf str 42 | ||
| withCString "hello %d\n" $ \str -> my_printf2 str 42 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,23 @@ | ||
| {-# LANGUAGE CApiFFI, TemplateHaskell #-} | ||
| {-# OPTIONS_GHC -ddump-splices #-} | ||
| module Main (main) where | ||
|
|
||
| import UserlandCApi | ||
| import Foreign.C.Types | ||
| import Foreign.C.String | ||
|
|
||
| foreign import capi "stdio.h printf" my_printf :: CString -> CInt -> IO () | ||
|
|
||
| localname :: () | ||
| localname = () | ||
|
|
||
| $(userlandCApi 'localname $ do | ||
| addInclude "<stdio.h>" | ||
| w <- freshCName "printf" | ||
| addC $ "void " ++ w ++ "(const char *fmt, int x) { printf(fmt, x); }" | ||
| addDec $ foreignImport w "my_printf2" [t| CString -> CInt -> IO () |]) | ||
|
|
||
| main :: IO () | ||
| main = do | ||
| withCString "hello %d\n" $ \str -> my_printf str 42 | ||
| withCString "hello %d\n" $ \str -> my_printf2 str 42 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,77 @@ | ||
| module UserlandCApi where | ||
|
|
||
| import Language.Haskell.TH | ||
| import Language.Haskell.TH.Syntax | ||
| import Data.IORef | ||
| import Data.Char | ||
| import Control.Monad | ||
|
|
||
| data S = S | ||
| { lname :: Name | ||
| , includes :: [String] | ||
| , csource :: [String] | ||
| , decs :: [DecQ] | ||
| } | ||
|
|
||
| newtype UC a = UC { unUC :: IORef S -> IO a } | ||
|
|
||
| instance Functor UC where | ||
| fmap = liftM | ||
| instance Applicative UC where | ||
| pure x = UC (\_ -> return x) | ||
| (<*>) = ap | ||
| instance Monad UC where | ||
| return = pure | ||
| m >>= k = UC $ \ref -> do | ||
| x <- unUC m ref | ||
| unUC (k x) ref | ||
|
|
||
| addInclude :: String -> UC () | ||
| addInclude incl = UC $ \ref -> do | ||
| s <- readIORef ref | ||
| writeIORef ref s { includes = includes s ++ [incl] } | ||
|
|
||
| -- TODO: add counter | ||
| freshCName :: String -> UC String | ||
| freshCName n = UC $ \ref -> do | ||
| s <- readIORef ref | ||
| return $ case lname s of | ||
| Name _ (NameG _ (PkgName p) (ModName m)) -> filter isLetter (p++m)++"_"++n++"_wrapper" | ||
| _ -> n ++ "_wrapper" | ||
|
|
||
| addC :: String -> UC () | ||
| addC c = UC $ \ref -> do | ||
| s <- readIORef ref | ||
| writeIORef ref s { csource = csource s ++ [c] } | ||
|
|
||
| addDec :: DecQ -> UC () | ||
| addDec d = UC $ \ref -> do | ||
| s <- readIORef ref | ||
| writeIORef ref s { decs = decs s ++ [d] } | ||
|
|
||
| runUC :: Name -> UC () -> IO S | ||
| runUC n m = do | ||
| ref <- newIORef (S n [] [] []) | ||
| unUC m ref | ||
| readIORef ref | ||
|
|
||
| foreignImport :: String -> String -> TypeQ -> DecQ | ||
| foreignImport cname hsname ty = ForeignD . ImportF CCall Safe cname (mkName hsname) <$> ty | ||
|
|
||
| userlandCApi | ||
| :: Name -- ^ This name is used to create unique identifiers, based on unit-id and current module. | ||
| -> UC () | ||
| -> DecsQ | ||
| userlandCApi localname uc = do | ||
| runIO $ putStrLn "hello at compile time" | ||
| s <- runIO (runUC localname uc) | ||
| let source' = source s | ||
| runIO $ print localname | ||
| runIO $ putStrLn source' | ||
| addForeignSource LangC source' | ||
| sequence (decs s) | ||
| where | ||
| source s = unlines $ | ||
| [ "#include " ++ l | ||
| | l <- includes s | ||
| ] ++ csource s |
Oops, something went wrong.