cgen 0.0.4 → 0.0.5
raw patch · 6 files changed
+62/−75 lines, 6 files
Files
- .gitignore +0/−4
- Changelog +0/−7
- TODO +0/−12
- cgen.cabal +1/−1
- src/CppGen.hs +29/−20
- src/HaskellGen.hs +32/−31
− .gitignore
@@ -1,4 +0,0 @@-tests/-dist/-.nix-tmp/
− Changelog
@@ -1,7 +0,0 @@-0.0.4 - 2012-04-05-- change function name mangling algorithm (parameter types are now appended-to the function name)-- fix bug where a type declaration might be output twice--0.0.3 - 2011-01-09-- add dummy library for dependency checks
− TODO
@@ -1,12 +0,0 @@-C++ parsing:----C/C++ generation:-- functions returning a reference are filtered out-- Static member functions have this pointer-- try-catch handling is missing--Haskell generation:-- Enums must be improved-- Out-params-
cgen.cabal view
@@ -2,7 +2,7 @@ -- see -- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. Name: cgen-Version: 0.0.4+Version: 0.0.5 Synopsis: generates Haskell bindings and C wrappers for C++ libraries Description: cgen parses C++ headers and generates C wrappers and Haskell bindings to a C++ library.
src/CppGen.hs view
@@ -33,9 +33,12 @@ refToPointerParam :: ParamDecl -> ParamDecl refToPointerParam p = p{vartype = refToPointer (vartype p)} +isRef :: String -> Bool+isRef t = last t == '&'+ refToPointer :: String -> String refToPointer t = - if last t == '&'+ if isRef t then init t ++ "*" else t @@ -63,7 +66,7 @@ hPrintf h "#endif\n\n" forM_ funs $ \fun -> do- hPutStrLn h $ funDeclaration (funname fun) (rettype fun) (paramFormat (params fun))+ hPutStrLn h $ funDeclaration fun True hPrintf h "\n" hPrintf h "}\n" hPrintf h "\n"@@ -76,10 +79,7 @@ hPrintf h "#include \"%s\"" headername hPrintf h "\n" forM_ (zip funs allfuns) $ \(fun, origfun) -> do- hPrintf h "%s %s(%s)\n" - (stripStatic $ rettype fun)- (funname fun)- (paramFormat (params fun))+ hPutStrLn h $ funDeclaration fun False hPrintf h "{\n" -- NOTE: do NOT call refToPointerParam or refParamsToPointers -- for prs, because then the information that the parameter@@ -113,8 +113,8 @@ typedefs = nub $ extratypedefs ++ usedtypedefs allenums = map snd $ filter (\(v, o) -> isEnum o && v == Public) $ concatMap classobjects classes funs = mangle $ map expandFun allfuns- excludeFun f = lastDef ' ' (correctType $ rettype f) == '&' || -- TODO: allow returned references- or (map (\e -> funname f =~ e) excls) ||+ functionReturnsRef f = lastDef ' ' (correctType $ rettype f) == '&'+ excludeFun f = or (map (\e -> funname f =~ e) excls) || or (map (\e -> fromMaybe "" (liftM snd (fnvisibility f)) =~ e) exclclasses) || take 8 (rettype f) == "template" || -- TODO: allow return types that start with "template" rettype f == "operator" || -- conversion operator is parsed as operator as return type@@ -163,13 +163,18 @@ | isStatic rttype && stripStatic rttype == "void" = printf " %s::%s(%s);" clname fnname fnparams | isStatic rttype - = printf " return %s::%s(%s);" clname fnname fnparams+ = printf " return %s%s::%s(%s);" getaddr clname fnname fnparams | otherwise - = printf " return this_ptr->%s(%s);" fnname fnparams+ = printf " return %sthis_ptr->%s(%s);" getaddr fnname fnparams+ where getaddr = if isRef rttype then "&" else "" -funDeclaration :: String -> String -> String -> String-funDeclaration fnname rttype fnparams =- printf "%s %s(%s);" (stripStatic rttype) fnname fnparams+funDeclaration :: Object -> Bool -> String+funDeclaration fun semicolon =+ printf "%s %s(%s)%s"+ (refToPointer $ stripStatic $ rettype fun)+ (funname fun)+ (paramFormat (params fun))+ (if semicolon then ";" else "") enumDeclaration :: String -> [EnumVal] -> String enumDeclaration ename evalues = @@ -199,13 +204,15 @@ tm = stripStatic $ stripExtra t mf1 = if isConst t then makeConst else id mf2 = makePtr (isPtr t)- in case mnt of- Nothing -> if '<' `elem` t && '>' `elem` t- then handleTemplateTypes rens t- else t- Just t' -> if isStatic (stripExtra t)- then "static " ++ ((mf1 . mf2) t')- else (mf1 . mf2) t'+ in case lookup t rens of+ Just t' -> t'+ Nothing -> case lookup tm rens of+ Nothing -> if '<' `elem` t && '>' `elem` t+ then handleTemplateTypes rens t+ else t+ Just t' -> if isStatic (stripExtra t)+ then "static " ++ ((mf1 . mf2) t')+ else (mf1 . mf2) t' handleTemplateTypes :: [(String, String)] -> String -> String handleTemplateTypes rens t = @@ -277,9 +284,11 @@ -- addNamespaceQual ["aa", "bb"] "foo" = "bb::aa::foo" -- addNamespaceQual ["aa", "bb"] "static foo" = "static bb::aa::foo"+-- TODO: won't work when both defined with both static and const. addNamespaceQual :: [String] -> String -> String addNamespaceQual ns n | isStatic n = "static " ++ addNamespaceQual ns (stripStatic n)+ | isConst n = "const " ++ addNamespaceQual ns (stripConst n) | otherwise = concatMap (++ "::") ns ++ n -- turn a "char& param" into "*param".
src/HaskellGen.hs view
@@ -47,11 +47,11 @@ deriving (Show) -- descriptor on how to convert a haskell type to a c type-data CConv = WithLambda String | CConvFunc String | NoCConv+data CConv = WithLambda String | CConvFunc String Bool | NoCConv deriving (Show) -- descriptor on how to convert a c type to a haskell type-data HsConv = HsConv String | NoHsConv+data HsConv = HsConv String Bool | NoHsConv deriving (Show) data HsFun = HsFun {@@ -124,7 +124,7 @@ let hstypeset = (S.\\) (S.fromList (map hstypify hstypes)) (S.fromList enumnames) inheritlist :: [(String, [String])]- inheritlist = M.toList . foldr (\(k, a) acc -> M.insertWith (++) k [a] acc) M.empty . map swap . expand . catMaybes $ + inheritlist = M.toList . foldr (\(k, a) acc -> M.insertWith' (++) k [a] acc) M.empty . map swap . expand . catMaybes $ for inheritdata $ \(cname, superclasses) -> if hstypify cname `S.member` hstypeset then Just (hstypify cname, catMaybes $ for superclasses $ \s ->@@ -206,7 +206,7 @@ | otherwise = let entype = stripNamespace . correctType . stripExtra . stripConst $ t in if entype `elem` enums- then (CConvFunc (printf "%sToCInt" $ decapitalize entype), entype)+ then (CConvFunc (printf "%sToCInt" $ decapitalize entype) False, entype) else case join $ fmap cleanCType $ cTypeToHs t of Nothing -> (NoCConv, printHsType enums t)@@ -230,7 +230,8 @@ mkCString (pnm, _) = printf "withCString %s $ \\c%s -> \n " pnm pnm resLift = case retparam of NoHsConv -> ""- HsConv n -> "liftM " ++ n ++ " $ "+ HsConv n False -> "liftM " ++ n ++ " $ "+ HsConv n True -> "(=<<) " ++ n ++ " $ " funcall = cPrefix ++ fn funparams = intercalate " " (map paramcall (zip inparams (map fst ptypes))) paramcall :: ((CConv, String), String) -> String@@ -239,8 +240,8 @@ then 'c' : pt else pt (pprefix, psuffix) = case cv of- CConvFunc n -> ("(" ++ n ++ " ", ")")- _ -> ("", "")+ CConvFunc n _ -> ("(" ++ n ++ " ", ")")+ _ -> ("", "") in concatMap mkCString cstrings ++ " " ++ resLift ++ " " ++ funcall ++ " " ++ funparams -- prints out the haskell function declaration and definition.@@ -343,39 +344,39 @@ cPrefix = "c_" -- in: a c type, like "int"--- out: the haskell conversion function for converting from haskell data type+-- out: the haskell conversion function for converting from a haskell data type to this type convFunc :: String -> CConv+convFunc ptype | (filter (/= ' ') . correctType . stripConst) ptype == "char*" = CConvFunc "peekCString" True convFunc ptype = case fromMaybe "" $ cTypeToHs ptype of- "CChar" -> CConvFunc "castCCharToChar" - "CSChar" -> CConvFunc "fromIntegral" - "CUChar" -> CConvFunc "fromIntegral" - "CShort" -> CConvFunc "fromIntegral" - "CUShort" -> CConvFunc "fromIntegral" - "CInt" -> CConvFunc "fromIntegral" - "CUInt" -> CConvFunc "fromIntegral" - "CSize" -> CConvFunc "fromIntegral" - "CLong" -> CConvFunc "fromIntegral" - "CULong" -> CConvFunc "fromIntegral" - "CFloat" -> CConvFunc "realToFrac" - "CDouble" -> CConvFunc "realToFrac" - "CBool" -> CConvFunc "fromBool" + "CChar" -> CConvFunc "castCharToCChar" False+ "CSChar" -> CConvFunc "fromIntegral" False+ "CUChar" -> CConvFunc "fromIntegral" False+ "CShort" -> CConvFunc "fromIntegral" False+ "CUShort" -> CConvFunc "fromIntegral" False+ "CInt" -> CConvFunc "fromIntegral" False+ "CUInt" -> CConvFunc "fromIntegral" False+ "CSize" -> CConvFunc "fromIntegral" False+ "CLong" -> CConvFunc "fromIntegral" False+ "CULong" -> CConvFunc "fromIntegral" False+ "CFloat" -> CConvFunc "realToFrac" False+ "CDouble" -> CConvFunc "realToFrac" False+ "CBool" -> CConvFunc "fromBool" False _ -> NoCConv -- in: a c type, like "int"--- out: the haskell conversion function for converting to haskell data type+-- out: the haskell conversion function for converting this c type to a haskell data type convRevFunc :: [String] -> String -> HsConv convRevFunc enums t- | fromMaybe "" (cTypeToHs t) == "CBool" = HsConv "toBool"+ | fromMaybe "" (cTypeToHs t) == "CBool" = HsConv "toBool" False | otherwise = - let ccf = convFunc t- in case ccf of- CConvFunc n -> HsConv n- _ -> - let entype = stripNamespace . correctType . stripExtra . stripConst $ t- in if entype `elem` enums- then HsConv $ printf "cintTo%s" entype- else NoHsConv+ case convFunc t of+ CConvFunc n iob -> HsConv n iob+ _ ->+ let entype = stripNamespace . correctType . stripExtra . stripConst $ t+ in if entype `elem` enums+ then HsConv (printf "cintTo%s" entype) False+ else NoHsConv paramNames :: Int -> [String] paramNames n = map ('p':) (map show [1..n])