hcc (empty) → 0.0.0

raw patch · 5 files changed

+141/−0 lines, 5 filesdep +basedep +bytestringdep +language-csetup-changed

Dependencies added: base, bytestring, language-c

Files

• LICENSE +27/−0
• RELEASE-NOTES +4/−0
• Setup.lhs +8/−0
• hcc.cabal +37/−0
• src/HCC.hs +65/−0

@@ -0,0 +1,27 @@+Copyright (c) Tom Hawkins 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

@@ -0,0 +1,4 @@+hcc 0.0.0    ???++- Initial release.+

@@ -0,0 +1,8 @@+#! /usr/bin/env runhaskell++> module Main (main) where+>+> import Distribution.Simple (defaultMain)+>+> main :: IO ()+> main = defaultMain

@@ -0,0 +1,37 @@+name:    hcc+version: 0.0.0++category: Compiler++synopsis: A toy C compiler.++description: A toy C compiler.++author:     Tom Hawkins <tomahawkins@gmail.com>+maintainer: Tom Hawkins <tomahawkins@gmail.com>++license:      BSD3+license-file: LICENSE++homepage: http://tomahawkins.org++build-type:    Simple+cabal-version: >= 1.6++extra-source-files:+  RELEASE-NOTES++executable hcc+  hs-source-dirs:   src+  main-is:          HCC.hs+  other-modules:+  build-depends:+    base       >= 4       && < 5,+    bytestring >= 0.9.1.4 && < 0.9.2,+    language-c >= 0.3.1.1 && < 0.4+  ghc-options:  -W+  extensions:++source-repository head+  type:     darcs+  location: http://patch-tag.com/r/tomahawkins/hcc/pullrepo

@@ -0,0 +1,65 @@+module Main (main) where++import qualified Data.ByteString as BS+import Language.C+import Language.C.System.GCC+import Language.C.System.Preprocess+import System.Environment+import System.Exit+import System.IO++main :: IO ()+main = do+  args <- getArgs+  if needHelp args then help else do+    let a = parseArgs Args { defines = [], includes = [], output = "a.out", inputs = [] } args+    a <- mapM (parse (includes a) (defines a)) (inputs a)+    mapM_ (print . pretty) a++data Args = Args+  { defines  :: [(String, String)]+  , includes :: [FilePath]+  , output   :: FilePath+  , inputs   :: [FilePath]+  } deriving Show++needHelp :: [String] -> Bool+needHelp args = null args || elem "-h" args || elem "--help" args++parseArgs :: Args -> [String] -> Args+parseArgs a b = case b of+  [] -> a+  "-o" : file : args -> parseArgs a { output = file } args+  arg : args | isInclude -> parseArgs a { includes = includes a ++ [drop 2 arg]    } args+             | isDefine  -> parseArgs a { defines  = defines a  ++ [(name, value)] } args+    where+    isInclude = length arg > 2 && take 2 arg == "-I"+    isDefine  = length arg > 2 && take 2 arg == "-D"+    (name, value') = span (/= '=') $ drop 2 arg+    value = if length value' <= 1 then "1" else tail value'+  files -> a { inputs = files }+ +help :: IO ()+help = putStrLn "synopsis : hcc {-Idir} {-Dmacro[=def]} [-o outfile] infile {infile}"++parse :: [FilePath] -> [(String,String)] -> FilePath -> IO CTranslUnit+parse includes defines file = do+  putStrLn $ "parsing " ++ file ++ "..."+  a <- preprocess includes defines file+  case parseC a (initPos file) of+    Left e  -> error $ show e+    Right a -> return a++preprocess :: [FilePath] -> [(String,String)] -> FilePath -> IO InputStream+preprocess includes defines file = do+  a <- runPreprocessor (newGCC "/usr/bin/gcc") CppArgs+    { cppOptions = map IncludeDir includes ++ map (\ (a,b) -> Define a b) defines+    , extraOptions = []+    , cppTmpDir = Nothing+    , inputFile = file+    , outputFile = Nothing+    }+  case a of+    Left e  -> exitWith e+    Right a -> return a+