diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,18 @@ +Benedikt Huber +Manuel M T Chakravarty +Duncan Coutts +Bertram Felgenhauer + +with code contributions and patches from + +Iavor Diatchki +Kevin Charter + +This project originated from the C parser component of c2hs, +for many additional contributors see AUTHORS.c2hs. + +Special thanks for their great support, comments and suggestions to: + +Duncan Coutts +Iavor Diatchki +Don Steward diff --git a/AUTHORS.c2hs b/AUTHORS.c2hs new file mode 100644 --- /dev/null +++ b/AUTHORS.c2hs @@ -0,0 +1,25 @@ +Manuel M T Chakravarty +Duncan Coutts + +with contributions from (alphabetical order) + +Bertram Felgenhauer +Ian Lynagh +André Pang +Jens-Ulrik Petersen +Armin Sander +Sean Seefried +Udo Stenzel +Axel Simon +Michael Weber + +Thanks for comments and suggestions to + +Roman Leshchinskiy +Jan Kort +Seth Kurtzberg +Simon Marlow +Matthias Neubauer +Sven Panne +Simon L. Peyton Jones +Volker Wysk diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,42 @@ +Changes 0.3.1 - 0.3.1.1 (Bug fix release) +========================================================================== + * Fix cabal file for compilation with GHC 6.10.1 (Aaron Tomb) + * Fix bug #22: Set file permission after copying input (thanks to Kevin Charter for reporting this bug) + * Fix bug #21: typedef can have more than one declarator (thanks to bkomuves for reporting this bug) + * Fix bug #18: adjustPos (change to line of another file) should set column offset to one + * Enhancement: add 'parseCFilePre' to module Language.C + * Enhancement: Add initPos and adjustPos to Data.Position + +Changes 0.3 - 0.3.1 +========================================================================== +Thu Aug 21 benedikt.huber@gmail.com + * add aliases for exposed parsers, in order to document them + +Fri Aug 15 benedikt.huber@gmail.com + * Remove NameMap from Data.Name. We will do this right when neccessary. + * Parser public API: expose parsers and the Parser Monad + * ParserMonad: Return updated name supply when executing parser + * Parser: Expose expression, statement, declaration and file parsers + * Data: Add newNameSupply ~ (namesStartingFrom 0) + +Thu Aug 14 17:13:29 CEST 2008 iavor.diatchki@gmail.com + * Add a utility function to create a "blank" set of cpp arguments. + * Make that analysis traversal monad abstract. + * Export the type synonym "Register" (and bump version) + +Wed Aug 13 12:00:57 CEST 2008 benedikt.huber@gmail.com + * add Data.Position: internalIdentAt + + +Old Changes +========================================================================== + +Mon Jun 9 23:12:46 CEST 2008 benedikt.huber@gmail.com + * License switched to 3-clause BSD + $ +- In accordance with the original authors, Language.C is now licensed as BSD-3. + See: + http://haskell.org/pipermail/c2hs/2008-June/000833.html + http://haskell.org/pipermail/c2hs/2008-June/000834.html + http://haskell.org/pipermail/c2hs/2008-June/000835.html + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,34 @@ += Language.C = + +Language.C is a parser and pretty-printer framework for C99 and the extensions of gcc. + +See http://www.sivity.net/projects/language.c/ + +== Build and Install == + +cabal install + +-- or -- + +runhaskell Setup configure FLAGS +runhaskell Setup build +runhaskell Setup install + +Provide the set of flags passing + --flags="" +to configure. + +== Sources == + +see src/README + +== Examples == + +A couple of small examples are available in /examples + +== Testing == + +A couple of regression tests can be run via +> cd test/harness; make + +For more tests, see test/README. diff --git a/dist/build/Language/C/Parser/Lexer.hs b/dist/build/Language/C/Parser/Lexer.hs --- a/dist/build/Language/C/Parser/Lexer.hs +++ b/dist/build/Language/C/Parser/Lexer.hs @@ -147,8 +147,8 @@ tok :: (Position -> CToken) -> Position -> P CToken tok tc pos = return (tc pos) -adjustPos :: String -> Position -> Position -adjustPos str (Position fname row _) = Position fname' row' 0 +linePragmaAdjust :: String -> Position -> Position +linePragmaAdjust str p@(Position fname row _) = Position fname' row' 1 where str' = dropWhite . drop 1 $ str (rowStr, str'') = span isDigit str' @@ -254,7 +254,7 @@ tok <- lexToken cont tok -alex_action_1 = \pos len str -> setPos (adjustPos (takeChars len str) pos) >> lexToken +alex_action_1 = \pos len str -> setPos (linePragmaAdjust (takeChars len str) pos) >> lexToken alex_action_4 = \pos len str -> idkwtok (takeChars len str) pos alex_action_5 = token_plus CTokILit (readCInteger OctalRepr) alex_action_6 = token_plus CTokILit (readCInteger DecRepr) diff --git a/language-c.cabal b/language-c.cabal --- a/language-c.cabal +++ b/language-c.cabal @@ -1,6 +1,6 @@ Name: language-c -Version: 0.3.1 -Cabal-Version: >= 1.2 +Version: 0.3.1.1 +Cabal-Version: >= 1.2.3 Build-Type: Simple License: BSD3 License-File: LICENSE @@ -8,14 +8,16 @@ Author: AUTHORS Maintainer: benedikt.huber@gmail.com Stability: experimental -Homepage: http://www.sivity.net/projects/language.c +Homepage: http://www.sivity.net/projects/language.c/ +Bug-reports: http://www.sivity.net/projects/language.c/ Synopsis: Analysis and generation of C code Description: Language C is a haskell library for the analysis and generation of C code. - It features a complete, well tested parser and pretty printer for all of C99 and a large + It features a complete, well tested parser and pretty printer for all of C99 and a large set of GNU extensions. Category: Language -Extra-Source-Files: src/Language/C/Parser/Lexer.x +Extra-Source-Files: AUTHORS AUTHORS.c2hs ChangeLog README + src/Language/C/Parser/Lexer.x src/Language/C/Parser/Parser.y Flag splitBase Description: Choose the new smaller, split-up base package. @@ -27,10 +29,10 @@ Build-Depends: filepath if flag(splitBase) - Build-Depends: base >= 3, process, directory, array, containers, pretty + Build-Depends: base >= 3 && < 4, process, directory, array, containers, pretty else Build-Depends: base < 3 - + if flag(useByteStrings) Build-Depends: bytestring >= 0.9.0 else @@ -38,7 +40,7 @@ Build-Tools: happy, alex Hs-Source-Dirs: src - Exposed-Modules: + Exposed-Modules: -- top-level Language.C -- data @@ -64,7 +66,7 @@ -- analysis [experimental] Language.C.Analysis Language.C.Analysis.SemError - Language.C.Analysis.SemRep + Language.C.Analysis.SemRep Language.C.Analysis.DefTable Language.C.Analysis.TravMonad Language.C.Analysis.AstAnalysis @@ -72,13 +74,13 @@ Language.C.Analysis.Debug -- semrep -> code [alpha] Language.C.Analysis.Export - Other-Modules: + Other-Modules: Language.C.Analysis.NameSpaceMap Language.C.Data.RList -- parser implementation Language.C.Parser.Builtin - Language.C.Parser.Lexer - Language.C.Parser.ParserMonad - Language.C.Parser.Tokens + Language.C.Parser.Lexer + Language.C.Parser.ParserMonad + Language.C.Parser.Tokens Language.C.Parser.Parser diff --git a/src/Language/C.hs b/src/Language/C.hs --- a/src/Language/C.hs +++ b/src/Language/C.hs @@ -16,7 +16,7 @@ -- See ----------------------------------------------------------------------------- module Language.C ( - parseCFile, + parseCFile, parseCFilePre, -- maybe change ? module Language.C.Data, module Language.C.Syntax, module Language.C.Pretty, @@ -29,7 +29,7 @@ import Language.C.Parser import Language.C.System.Preprocess --- | preprocess and parse a C source file +-- | preprocess (if neccessary) and parse a C source file -- -- > Synopsis: parseCFile preprocesssor tmp-dir? cpp-opts file -- > Example: parseCFile (newGCC "gcc") Nothing ["-I/usr/include/gtk-2.0"] my-gtk-exts.c @@ -39,7 +39,15 @@ then let cpp_args = (rawCppArgs args input_file) { cppTmpDir = tmp_dir_opt } in runPreprocessor cpp cpp_args >>= handleCppError else readInputStream input_file - return$ parseC input_stream (Position input_file 1 1) + return$ parseC input_stream (initPos input_file) where handleCppError (Left exitCode) = fail $ "Preprocessor failed with " ++ show exitCode handleCppError (Right ok) = return ok + +-- | parse an already preprocessed C file +-- +-- > Synopsis: parseCFilePre file.i +parseCFilePre :: FilePath -> IO (Either ParseError CTranslUnit) +parseCFilePre file = do + input_stream <- readInputStream file + return $ parseC input_stream (initPos file) diff --git a/src/Language/C/Analysis/AstAnalysis.hs b/src/Language/C/Analysis/AstAnalysis.hs --- a/src/Language/C/Analysis/AstAnalysis.hs +++ b/src/Language/C/Analysis/AstAnalysis.hs @@ -88,14 +88,21 @@ -- | Analyse a top-level declaration other than a function definition analyseExtDecls :: (MonadTrav m) => CDecl -> m () analyseExtDecls decl@(CDecl declspecs declrs node) - | (Just declspecs') <- hasTypeDef declspecs = - case declrs of - [(Just tydeclr,Nothing,Nothing)] -> analyseTypeDef declspecs' tydeclr node - _ -> astError node "bad typdef declaration: declarator missing or bitfieldsize/initializer present" - | null declrs = analyseTypeDecl decl >> return () - | otherwise = mapM_ (uncurry convertVarDeclr) $ zip (True : repeat False) declrs + | null declrs = + case typedef_spec of Just _ -> astError node "bad typedef declaration: missing declarator" + Nothing -> analyseTypeDecl decl >> return () + | (Just declspecs') <- typedef_spec = mapM_ (uncurry (analyseTyDef declspecs')) declr_list + | otherwise = mapM_ (uncurry analyseVarDeclr) declr_list where - convertVarDeclr handle_sue_def (Just declr, init_opt, Nothing) = do + declr_list = zip (True : repeat False) declrs + typedef_spec = hasTypeDef declspecs + + analyseTyDef declspecs' handle_sue_def declr = + case declr of + (Just tydeclr, Nothing , Nothing) -> analyseTypeDef handle_sue_def declspecs' tydeclr node + _ -> astError node "bad typdef declaration: bitfieldsize or initializer present" + + analyseVarDeclr handle_sue_def (Just declr, init_opt, Nothing) = do -- analyse the declarator vardeclInfo@(VarDeclInfo _ _ _ _ typ _) <- analyseVarDecl handle_sue_def declspecs declr [] -- declare / define the object @@ -104,16 +111,17 @@ if (isFunctionType typ) then extFunProto vardeclInfo else extVarDecl vardeclInfo init_opt' - convertVarDeclr _ (Nothing,_,_) = astError node "abstract declarator in object declaration" - convertVarDeclr _ (_,_,Just bitfieldSz) = astError node "bitfield size in object declaration" + analyseVarDeclr _ (Nothing,_,_) = astError node "abstract declarator in object declaration" + analyseVarDeclr _ (_,_,Just bitfieldSz) = astError node "bitfield size in object declaration" + isTypeOfExpr (TypeOfExpr _) = True isTypeOfExpr _ = False -- | Analyse a typedef -analyseTypeDef :: (MonadTrav m) => [CDeclSpec] -> CDeclr -> NodeInfo -> m () -analyseTypeDef declspecs declr node_info = do +analyseTypeDef :: (MonadTrav m) => Bool -> [CDeclSpec] -> CDeclr -> NodeInfo -> m () +analyseTypeDef handle_sue_def declspecs declr node_info = do -- analyse the declarator - (VarDeclInfo name is_inline storage_spec attrs ty declr_node) <- analyseVarDecl True declspecs declr [] + (VarDeclInfo name is_inline storage_spec attrs ty declr_node) <- analyseVarDecl handle_sue_def declspecs declr [] checkValidTypeDef is_inline storage_spec attrs let ident = identOfVarName name handleTypeDef (TypeDef ident ty attrs node_info) diff --git a/src/Language/C/Data.hs b/src/Language/C/Data.hs --- a/src/Language/C/Data.hs +++ b/src/Language/C/Data.hs @@ -19,7 +19,7 @@ -- * Unqiue names Name(..),newNameSupply, -- * Source code positions - Position(..),Pos(..), + Position(..),Pos(..),initPos, posFile,posRow,posColumn, nopos,builtinPos,internalPos, isSourcePos,isBuiltinPos,isInternalPos, diff --git a/src/Language/C/Data/Position.hs b/src/Language/C/Data/Position.hs --- a/src/Language/C/Data/Position.hs +++ b/src/Language/C/Data/Position.hs @@ -14,12 +14,12 @@ -- -- source text positions -- - Position(Position), + Position(Position),initPos, posFile,posRow,posColumn,isSourcePos, nopos, isNoPos, builtinPos, isBuiltinPos, internalPos, isInternalPos, - incPos, tabPos, retPos, + incPos, tabPos, retPos, adjustPos, Pos(..), ) where import Data.Generics @@ -67,6 +67,10 @@ class Pos a where posOf :: a -> Position +-- | initialize a Position to the start of the translation unit starting in the given file +initPos :: FilePath -> Position +initPos file = Position file 1 1 + -- | returns @True@ if the given position refers to an actual source file isSourcePos :: Position -> Bool isSourcePos (Position _ row col) = row >= 0 && col >= 0 @@ -98,15 +102,24 @@ isInternalPos (Position _ (-1) 2) = True isInternalPos _ = False +{-# INLINE incPos #-} -- | advance column incPos :: Position -> Int -> Position incPos (Position fname row col) n = Position fname row (col + n) +{-# DEPRECATED tabPos "Use 'incPos column-adjustment' instead" #-} -- | advance column to next tab positions (tabs are considered to be at every 8th column) tabPos :: Position -> Position tabPos (Position fname row col) = Position fname row (col + 8 - (col - 1) `mod` 8) +{-# INLINE retPos #-} -- | advance to next line retPos :: Position -> Position retPos (Position fname row _col) = Position fname (row + 1) 1 + +{-# INLINE adjustPos #-} +-- | adjust position: change file and line number, reseting column to 1. This is usually +-- used for #LINE pragmas. +adjustPos :: FilePath -> Int -> Position -> Position +adjustPos fname row (Position _ _ _) = Position fname row 1 diff --git a/src/Language/C/Parser/Lexer.x b/src/Language/C/Parser/Lexer.x --- a/src/Language/C/Parser/Lexer.x +++ b/src/Language/C/Parser/Lexer.x @@ -135,7 +135,7 @@ -- doesn't say how many ints there can be, we allow an unbound number -- \#$space*@int$space*(\"($infname|@charesc)*\"$space*)?(@int$space*)*$eol - { \pos len str -> setPos (adjustPos (takeChars len str) pos) >> lexToken } + { \pos len str -> setPos (linePragmaAdjust (takeChars len str) pos) >> lexToken } -- #pragma directive (K&R A12.8) -- @@ -345,8 +345,8 @@ tok :: (Position -> CToken) -> Position -> P CToken tok tc pos = return (tc pos) -adjustPos :: String -> Position -> Position -adjustPos str (Position fname row _) = Position fname' row' 0 +linePragmaAdjust :: String -> Position -> Position +linePragmaAdjust str p@(Position fname row _) = Position fname' row' 1 where str' = dropWhite . drop 1 $ str (rowStr, str'') = span isDigit str' diff --git a/src/Language/C/System/GCC.hs b/src/Language/C/System/GCC.hs --- a/src/Language/C/System/GCC.hs +++ b/src/Language/C/System/GCC.hs @@ -33,8 +33,11 @@ runCPP gcc cpp_args = do -- copy the input to the outputfile, because in case the input is preprocessed, -- gcc -E will do nothing. - maybe (return()) (copyFile (inputFile cpp_args)) (outputFile cpp_args) + maybe (return()) (copyWritable (inputFile cpp_args)) (outputFile cpp_args) rawSystem (gccPath gcc) (buildCppArgs cpp_args) + where copyWritable source target = do copyFile source target + p <- getPermissions target + setPermissions target p{writable=True} -- | Parse arguments for preprocessing via GCC. -- At least one .c, .hc or .h file has to be present.