c2hsc 0.3.3 → 0.4.0

raw patch · 3 files changed

+56/−21 lines, 3 files

Files

• Main.hs +54/−18
• README.md +1/−2
• c2hsc.cabal +1/−1

@@ -102,8 +102,9 @@     case result of       Left err     -> error $ "Failed to run cpp: " ++ show err       Right stream -> do-        let HscOutput hscs helpercs _ =-              execState (parseCFile stream fileName (initPos fileName))+        let pos = initPos fileName+            HscOutput hscs helpercs _ =+              execState (parseCFile stream (posFile pos) pos)                         newHscState         writeProducts opts fileName hscs helpercs @@ -216,8 +217,7 @@     generateHsc = traverse_ (appendNode fileName)  declInFile :: FilePath -> CExtDecl -> Bool-declInFile fileName =-  (== takeFileName fileName) . takeFileName . posFile . posOfNode . declInfo+declInFile fileName = (== fileName) . posFile . posOfNode . declInfo  declInfo :: CExtDecl -> NodeInfo declInfo (CDeclExt (CDecl _ _ info))       = info@@ -240,9 +240,10 @@  appendNode fp dx@(CDeclExt (CDecl declSpecs items _)) = do   case items of-    [] -> do-      appendHsc $ "{- " ++ P.render (pretty dx) ++ " -}"-      appendType declSpecs ""+    [] ->+      when (declInFile fp dx) $ do+        appendHsc $ "{- " ++ P.render (pretty dx) ++ " -}"+        appendType declSpecs ""      _ ->       for_ items $ \(declrtr, _, _) ->@@ -269,10 +270,10 @@                     "" -> return ()                     _  -> defineType nm dname                 _ -> return ()--  where splitDecl declrtr = do  -- in the Maybe Monad-          d@(CDeclr ident ddrs _ _ _) <- declrtr-          return (d, ddrs, case ident of Just (Ident nm _ _) -> nm; _ -> "")+  where+    splitDecl declrtr = do      -- in the Maybe Monad+      d@(CDeclr ident ddrs _ _ _) <- declrtr+      return (d, ddrs, case ident of Just (Ident nm _ _) -> nm; _ -> "")  appendNode fp dx@(CFDefExt (CFunDef declSpecs declrtr _ _ _)) =   -- Assume functions defined in headers are inline functions@@ -410,6 +411,14 @@     fullTypeName' :: Signedness -> [CDeclarationSpecifier a] -> Output String     fullTypeName' _ [] = return "" +    fullTypeName' s (CTypeQual qual:xs) =+      if cStyle+      then do+        baseType <- fullTypeName' s xs+        return $ qualToStr qual ++ " " ++ baseType+      else+        fullTypeName' s xs+     fullTypeName' _ (CTypeSpec (CSignedType _):[]) =       if cStyle then return "signed" else return "CInt"     fullTypeName' _ (CTypeSpec (CUnsigType _):[]) =@@ -443,28 +452,55 @@         funTypes xs bt    = sequence $                             map (cdeclTypeName' cStyle) xs ++ [pure bt] -applyDeclrs cStyle baseType (CPtrDeclr _ _:[])-  | cStyle && baseType == "" = return "void *"-  | cStyle                  = return $ baseType ++ "*"+applyDeclrs cStyle baseType decl@(CPtrDeclr quals _:[])+  | cStyle && baseType == "" = applyDeclrs cStyle "void" decl+  | cStyle                  = return $ baseType ++ " *"+                                    ++ preQualsToString quals   | baseType == ""          = return "Ptr ()"   | baseType == "CChar"     = return "CString"   | otherwise               = return $ "Ptr " ++ baseType -applyDeclrs cStyle baseType (CPtrDeclr _ _:xs)+applyDeclrs cStyle baseType (CPtrDeclr quals _:xs)   | cStyle    = concatM [ applyDeclrs cStyle baseType xs-                        , pure " *" ]+                        , pure " *"+                        , pure (preQualsToString quals) ]   | otherwise = concatM [ pure "Ptr ("                         , applyDeclrs cStyle baseType xs                         , pure ")" ] -applyDeclrs cStyle baseType (CArrDeclr {}:xs)-  | cStyle    = concatM [ applyDeclrs cStyle baseType xs+applyDeclrs cStyle baseType (CArrDeclr quals _ _:xs)+  | cStyle    = concatM [ pure (sufQualsToString quals)+                        , applyDeclrs cStyle baseType xs                         , pure "[]" ]   | otherwise = concatM [ pure "Ptr ("                         , applyDeclrs cStyle baseType xs                         , pure ")" ]  applyDeclrs _ baseType _ = return baseType++prefixWith :: a -> [a] -> [a]+prefixWith _ [] = []+prefixWith x xs = (x:xs)++preQualsToString :: [CTypeQualifier a] -> String+preQualsToString = prefixWith ' ' . qualsToStr++sufQualsToString :: [CTypeQualifier a] -> String+sufQualsToString = prefixWith ' ' . qualsToStr++suffixWith :: a -> [a] -> [a]+suffixWith _ [] = []+suffixWith x xs = xs ++ [x]++qualsToStr :: [CTypeQualifier a] -> String+qualsToStr = intercalate " " . map qualToStr++qualToStr :: CTypeQualifier t -> String+qualToStr (CConstQual _)  = "const"+qualToStr (CVolatQual _)  = "volatile"+qualToStr (CRestrQual _)  = "restricted"+qualToStr (CInlineQual _) = ""+qualToStr (CAttrQual _)   = error "Unimplemented: attribute qualifiers"  -- Simple translation from C types to Foreign.C.Types types.  We represent -- Void as the empty string so that returning void becomes IO (), and passing

@@ -14,8 +14,7 @@   - Filename matching is not accurate enough  - Pointers to "struct foo" are being rendered as Ptr () [void *]- - Function pointers of void return type are rendered incorrectlyb- - `const` is being dropped from BC_INLINE macros+ - Function pointers of void return type are rendered incorrectly  - Handle type synonyms (output them as type a = b)  - Global variables are not being emitted  - Varargs functions do not translate

@@ -1,6 +1,6 @@ Name: c2hsc -Version:  0.3.3+Version:  0.4.0 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