c2hsc 0.5.1 → 0.6.2
raw patch · 3 files changed
+72/−31 lines, 3 files
Files
- Main.hs +68/−29
- README.md +3/−1
- c2hsc.cabal +1/−1
Main.hs view
@@ -6,12 +6,12 @@ import Control.Monad hiding (sequence) import Control.Monad.Trans.State import Data.Char-import Data.Foldable hiding (concat)-import Data.List+import Data.Foldable hiding (concat, mapM_)+import Data.List as L import Data.List.Split import qualified Data.Map as M import Data.Maybe-import Data.Traversable hiding (mapM)+import Data.Traversable hiding (mapM, forM) import Language.C.Data.Ident import Language.C.Data.InputStream import Language.C.Data.Node@@ -21,7 +21,7 @@ import Language.C.Syntax.AST import Language.C.System.GCC import Language.C.System.Preprocess-import Prelude hiding (concat, sequence, mapM)+import Prelude hiding (concat, sequence, mapM, mapM_, foldr) import System.Console.CmdArgs import System.Directory import System.Environment@@ -31,7 +31,7 @@ import Text.StringTemplate version :: String-version = "0.5.1"+version = "0.6.2" copyright :: String copyright = "2012"@@ -44,6 +44,7 @@ , cppopts :: String , prefix :: String , useStdout :: Bool+ , overrides :: FilePath , verbose :: Bool , debug :: Bool , files :: [FilePath] }@@ -59,6 +60,8 @@ &= help "Use PREFIX when naming modules" , useStdout = def &= name "stdout" &= help "Send all output to stdout (for testing)"+ , overrides = def &= typFile+ &= help "FILE contains \"C type -> FFI type\" translations" , verbose = def &= name "v" &= help "Report progress verbosely" , debug = def &= name "D"@@ -103,24 +106,49 @@ case result of Left err -> error $ "Failed to run cpp: " ++ show err Right stream -> do+ overrideState <- defineTypeOverrides (overrides opts) let pos = initPos fileName HscOutput hscs helpercs _ =- execState (parseCFile stream (posFile pos) pos)+ execState (overrideState >>+ parseCFile stream (posFile pos) pos) newHscState writeProducts opts fileName hscs helpercs +defineTypeOverrides :: FilePath -> IO (Output ())+defineTypeOverrides [] = return (void defaultOverrides)+defineTypeOverrides overridesFile = do+ contents <- readFile overridesFile+ return $ mapM_ (\line ->+ let (cName:ffiName:[]) = splitOn " -> " line+ in overrideType cName ffiName)+ (lines contents)++overrideType :: String -> String -> Output ()+overrideType cName ffiName =+ defineType cName Typedef { typedefName = ffiName+ , typedefOverride = True }++defaultOverrides :: Output ()+defaultOverrides = mapM_ (uncurry overrideType)+ [ ("size_t", "CSize")+ , ("intptr_t", "IntPtr")+ , ("uintptr_t", "WordPtr") ]+ -- Write out the gathered data writeProducts :: C2HscOptions -> FilePath -> [String] -> [String] -> IO () writeProducts opts fileName hscs helpercs = do let code = newSTMP $- unlines [ "#include <bindings.dsl.h>"- , "#include <git2.h>"+ unlines [ "{-# OPTIONS_GHC -fno-warn-unused-imports #-}"+ , "#include <bindings.dsl.h>"+ , "#include \"$headerFileName$\"" , "module $libName$.$cFileName$ where"+ , "import Foreign.Ptr" , "#strict_import" , "" ] vars = [ ("libName", prefix opts)- , ("cFileName", cap) ]+ , ("cFileName", cap)+ , ("headerFileName", fileName) ] cap = capitalize . dropExtension . takeFileName $ fileName target = cap ++ ".hsc" @@ -176,7 +204,9 @@ -- pure, and since the data sets involved are relatively small, performance is -- not a critical issue. -type TypeMap = M.Map String String+data Typedef = Typedef { typedefName :: String+ , typedefOverride :: Bool }+type TypeMap = M.Map String Typedef data HscOutput = HscOutput [String] [String] TypeMap type Output = State HscOutput @@ -193,12 +223,15 @@ HscOutput xs helpercs types <- get put $ HscOutput xs (helpercs ++ [helperc]) types -defineType :: String -> String -> Output ()+defineType :: String -> Typedef -> Output () defineType key value = do HscOutput xs ys types <- get- put $ HscOutput xs ys (M.insert key value types)+ hasOverride <- fmap typedefOverride <$> lookupType key+ case hasOverride of+ Just True -> return ()+ _ -> put $ HscOutput xs ys (M.insert key value types) -lookupType :: String -> Output (Maybe String)+lookupType :: String -> Output (Maybe Typedef) lookupType key = do HscOutput _ _ types <- get return $ M.lookup key types@@ -240,7 +273,7 @@ appendNode :: FilePath -> CExtDecl -> Output () -appendNode fp dx@(CDeclExt (CDecl declSpecs items _)) = do+appendNode fp dx@(CDeclExt (CDecl declSpecs items _)) = case items of [] -> when (declInFile fp dx) $ do@@ -255,7 +288,7 @@ when (declInFile fp dx) $ appendFunc "#ccall" declSpecs declrtr' - _ -> do+ _ -> -- If the type is a typedef, record the equivalence so we can -- look it up later case declSpecs of@@ -269,8 +302,8 @@ when (declInFile fp dx) $ appendHsc $ "#synonym_t " ++ nm ++ " , " ++ dname - defineType nm dname-+ defineType nm Typedef { typedefName = dname+ , typedefOverride = False } _ -> when (declInFile fp dx) $ do dname <- declSpecTypeName declSpecs@@ -424,7 +457,10 @@ if cStyle then do baseType <- fullTypeName' s xs- return $ qualToStr qual ++ " " ++ baseType+ return $ let q = qualToStr qual+ in if null q+ then baseType+ else q ++ " " ++ baseType else fullTypeName' s xs @@ -454,7 +490,9 @@ applyDeclrs cStyle baseType (CFunDeclr (Right (decls, _)) _ _:_) | cStyle = renderList ", " (funTypes decls baseType) | otherwise = do- argTypes <- renderList " -> " (funTypes decls baseType)+ argTypes <- renderList " -> " (funTypes decls (if null baseType+ then "IO ()"+ else baseType)) return $ "FunPtr (" ++ argTypes ++ ")" where renderList str xs = intercalate str <$> filter (not . null) <$> xs@@ -487,22 +525,22 @@ applyDeclrs _ baseType _ = return baseType -prefixWith :: a -> [a] -> [a]-prefixWith _ [] = []-prefixWith x xs = (x:xs)- preQualsToString :: [CTypeQualifier a] -> String preQualsToString = prefixWith ' ' . qualsToStr +prefixWith :: a -> [a] -> [a]+prefixWith _ [] = []+prefixWith x xs = x:xs+ sufQualsToString :: [CTypeQualifier a] -> String-sufQualsToString = prefixWith ' ' . qualsToStr+sufQualsToString = suffixWith ' ' . qualsToStr suffixWith :: a -> [a] -> [a] suffixWith _ [] = [] suffixWith x xs = xs ++ [x] qualsToStr :: [CTypeQualifier a] -> String-qualsToStr = intercalate " " . map qualToStr+qualsToStr = unwords . map qualToStr qualToStr :: CTypeQualifier t -> String qualToStr (CConstQual _) = "const"@@ -541,7 +579,10 @@ typeName (CTypeDef (Ident nm _ _) _) _ = do definition <- lookupType nm- return $ fromMaybe ("<" ++ nm ++ ">") definition+ case definition of+ Nothing -> return $ "<" ++ nm ++ ">"+ Just (Typedef { typedefName = defNm }) ->+ return defNm typeName (CSUType (CStruct _ (Just (Ident nm _ _)) _ _ _) _) _ = return $ "<" ++ nm ++ ">"@@ -582,9 +623,7 @@ Unsigned -> return "unsigned long" _ -> return "long" -cTypeName (CTypeDef (Ident nm _ _) _) _ = do- definition <- lookupType nm- return $ fromMaybe nm definition+cTypeName (CTypeDef (Ident nm _ _) _) _ = return nm cTypeName (CComplexType _) _ = return "" cTypeName (CSUType _ _) _ = return ""
README.md view
@@ -12,7 +12,9 @@ Known issues: - - Varargs functions do not translate+ - "void (*foo)(int, intptr_t *)" becomes "FunPtr (CInt -> Ptr IntPtr)"+ - Need to output vararg functions with a comment mentioning they are not+ translatable to the Haskell FFI Also, please note that this tool will never be 100% accurate. It cannot translate macros, or anything related to the preprocessor, for example. It
c2hsc.cabal view
@@ -1,6 +1,6 @@ Name: c2hsc -Version: 0.5.1+Version: 0.6.2 Synopsis: Convert C API header files to .hsc and .hsc.helper.c files Description: Convert C API header files to .hsc and .hsc.helper.c files