[hoc-cvs] [hoc commit] r315 - in trunk/hoc: . InterfaceGenerator2

[<cod...@go...>]

Author: wol...@gm...
Date: Sun Sep 28 10:40:43 2008
New Revision: 315

Modified:
    trunk/hoc/HOC.cabal
    trunk/hoc/InterfaceGenerator2/Headers.hs
    trunk/hoc/InterfaceGenerator2/Main.hs

Log:
Command line option improvements:
allow to specify SDK on command line
add --dump-preprocessed and --dump-parsed options for debugging


Modified: trunk/hoc/HOC.cabal
==============================================================================
--- trunk/hoc/HOC.cabal	(original)
+++ trunk/hoc/HOC.cabal	Sun Sep 28 10:40:43 2008
@@ -67,6 +67,7 @@
      main-is: Main.hs
      hs-source-dirs: HOC, InterfaceGenerator2

+    build-depends: filepath
      if flag(BinaryInterfaces)
          build-depends: binary >= 0.2
          cpp-options: -DBINARY_INTERFACES

Modified: trunk/hoc/InterfaceGenerator2/Headers.hs
==============================================================================
--- trunk/hoc/InterfaceGenerator2/Headers.hs	(original)
+++ trunk/hoc/InterfaceGenerator2/Headers.hs	Sun Sep 28 10:40:43 2008
@@ -1,9 +1,14 @@
-module Headers where
+module Headers( ModuleName,
+                HeaderInfo(..),
+                headersIn,
+                headersForFramework,
+                loadHeaders ) where

  import Parser(header)
  import SyntaxTree(Declaration)

  import Control.Exception(evaluate)
+import Control.Monad(when)
  import Data.Char(isAlphaNum, toUpper)
  import Data.List(isPrefixOf,isSuffixOf,partition)
  import Data.Maybe(mapMaybe)
@@ -14,6 +19,7 @@
  import qualified Data.ByteString.Char8 as BS
  import Progress
  import Preprocessor
+import System.FilePath

  type ModuleName = ByteString
  data HeaderInfo = HeaderInfo ModuleName [ModuleName] [Declaration]
@@ -42,14 +48,13 @@

  headersIn dirName prefix = do
      files <- getDirectoryContents dirName
-    return [ (fn, dirName ++ fn, haskellizeModuleName $
+    return [ (fn, dirName </> fn, haskellizeModuleName $
                                   prefix ++ "." ++ takeWhile (/= '.') fn)
             | fn <- files, ".h" `isSuffixOf` fn {- , fn /= (prefix ++ ".h")  
-} ]

-headersForFramework framework =
+headersForFramework prefix framework =
      if System.Info.os == "darwin"
-        -- then headersIn ("/System/Library/Frameworks/" ++ framework  
++ ".framework/Headers/") framework
-        then headersIn  
("/Developer/SDKs/MacOSX10.4u.sdk/System/Library/Frameworks/" ++ framework  
++ ".framework/Headers/") framework
+        then headersIn (prefix </> "System/Library/Frameworks" </>  
(framework ++ ".framework") </> "Headers") framework
          else headersIn ("/usr/lib/GNUstep/System/Library/Headers/" ++  
framework ++ "/") framework

  translateObjCImport imp = haskellizeModuleName $
@@ -58,16 +63,18 @@
          slashToDot '/' = '.'
          slashToDot c = c

-loadHeaders progress headers =
+loadHeaders (dumpPreprocessed, dumpParsed) progress headers =
      mapM (\(headerFileName, headerPathName, moduleName) -> do
                  -- putStrLn $ "Parsing " ++ headerFileName
                  contents <- readFile $ headerPathName
                  evaluate (length contents)
                  let imports = findImports contents
                      preprocessed = preprocess headerFileName {-  
stripPreprocessor -} contents
+                when dumpPreprocessed $ writeFile ("preprocessed-" ++  
headerFileName) $ preprocessed
                  result <- case parse header headerFileName preprocessed of
                      Left err -> error $ show err
-                    Right decls ->
+                    Right decls -> do
+                        when dumpParsed $ writeFile ("parsed-" ++  
headerFileName) $ unlines $ map show decls
                          return $ HeaderInfo (BS.pack moduleName)
                                              (map (BS.pack .  
translateObjCImport) imports) decls
                  reportProgress progress nHeaders

Modified: trunk/hoc/InterfaceGenerator2/Main.hs
==============================================================================
--- trunk/hoc/InterfaceGenerator2/Main.hs	(original)
+++ trunk/hoc/InterfaceGenerator2/Main.hs	Sun Sep 28 10:40:43 2008
@@ -9,6 +9,7 @@
  import System.IO
  import System.Environment           ( getArgs )
  import System.Console.GetOpt
+import System.FilePath              ( (</>) )
  import Control.Exception            ( finally )

  import Messages
@@ -116,7 +117,10 @@
          oAdditionalCode :: Maybe String,
          oShowZapped :: Bool,
          oDumpInitial :: Bool,
-        oQuiet :: Bool
+        oQuiet :: Bool,
+        oPrefix :: String,
+        oDumpPreprocessed :: Bool,
+        oDumpParsed :: Bool
      }

  processFramework :: Options -> IO ()
@@ -156,11 +160,12 @@
          headers <- fmap concat $ flip mapM (oHeaderDirectories options) $
                          \hd -> case hd of
                              FrameworkHeaders framework
-                                -> headersForFramework framework
+                                -> headersForFramework (oPrefix options)  
framework
                              Headers path
                                  -> headersIn path (oFrameworkName options)

-        loaded <- loadHeaders parseProgress headers
+        loaded <- loadHeaders (oDumpPreprocessed options, oDumpParsed  
options)
+                              parseProgress headers

          let enumHacked = map hackEnumNames loaded

@@ -277,9 +282,25 @@
              "dump all entities after parsing",
          Option ['q'] ["quiet"]
              (NoArg (\o -> o { oQuiet = True }))
-            "don't report progress"
+            "don't report progress",
+        Option ['p'] ["prefix"]
+            (ReqArg (\p o -> o { oPrefix = p }) "path")
+            "prefix for system framework paths",
+        Option ['s'] ["sdk"]
+            (ReqArg (\sdk o -> o { oPrefix = sdkDirectory sdk }) "sdk")
+            "name of SDK to use",
+        Option [] ["dump-preprocessed"]
+            (NoArg (\o -> o { oDumpPreprocessed = True }))
+            "dump preprocessor result to many little files",
+        Option [] ["dump-parsed"]
+            (NoArg (\o -> o { oDumpParsed = True }))
+            "dump parse result to many little files"
+
      ]

+sdkDirectory sdk = "/Developer/SDKs"
+               </> (sdk ++ ".sdk")
+
  main :: IO ()
  main = do
      args <- getArgs
@@ -294,7 +315,10 @@
                          oAdditionalCode = Nothing,
                          oShowZapped = False,
                          oDumpInitial = False,
-                        oQuiet = False
+                        oQuiet = False,
+                        oPrefix = "/",
+                        oDumpPreprocessed = False,
+                        oDumpParsed = False
                      }
                  options = foldl (flip ($)) options0 optionsF
              in