|
From: <cod...@go...> - 2008-09-28 17:41:16
|
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
|