diff --git a/.gitignore b/.gitignore deleted file mode 100644 --- a/.gitignore +++ /dev/null @@ -1,4 +0,0 @@ -tests/ -dist/ -.nix -tmp/ diff --git a/Changelog b/Changelog deleted file mode 100644 --- a/Changelog +++ /dev/null @@ -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 diff --git a/TODO b/TODO deleted file mode 100644 --- a/TODO +++ /dev/null @@ -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 - diff --git a/cgen.cabal b/cgen.cabal --- a/cgen.cabal +++ b/cgen.cabal @@ -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. diff --git a/src/CppGen.hs b/src/CppGen.hs --- a/src/CppGen.hs +++ b/src/CppGen.hs @@ -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". diff --git a/src/HaskellGen.hs b/src/HaskellGen.hs --- a/src/HaskellGen.hs +++ b/src/HaskellGen.hs @@ -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])