Permalink
Browse files

Update wxdirect with removal of Eiffel.

Ignore-this: 2310a3a161de4ca9860eed8b9dff5695

Continue to take patches from Dave Tapely's darcsden branch and merge them
to mainline.

This includes at least the following changes from Dave's repo:

Thu Nov  3 03:33:11 GMT 2011  Eric Kow <eric.kow@gmail.com>
  * wxdirect: Bump to 0.14

Thu Nov  3 03:32:58 GMT 2011  Eric Kow <eric.kow@gmail.com>
  * wxdirect: Modernise exception handling.

Thu Nov  3 03:30:31 GMT 2011  Eric Kow <eric.kow@gmail.com>
  * wxdirect: Strip away ability to deal with Eiffel files.

Thu Oct  6 20:18:16 BST 2011  dukedave@gmail.com
  * Replace debugging version of writeFileLazy with release one

Thu Oct  6 19:53:42 BST 2011  dukedave@gmail.com
  * Use writeFileLazy in wxdirect to reduce wxcore compile times
  Rather than having wxdirect write out newly generated .hs files every
  time it is run, we now only write the files if they have changed.
  By doing this we don't touch the files modified time unless we have to,
  and because the modified times haven't changed GHC won't rebuild them.

Thu Oct  6 19:45:37 BST 2011  dukedave@gmail.com
  * Don't print version information in to .hs files produced by wxdirect
  As part of the changes to decrease the build time of wxHaskell, I'm going to
  modify all the writeFile calls in wxdirect such that they first check if
  their output is different from the current source file *before* they touch it.
  However if a version is written in to the file then the source will always
  be different; instead of writing an exception to this I motion that there is no
  need to be writing the version into the source anyway, I could find no reference
  to the version strings nor use of them.

Wed Oct  5 19:14:15 BST 2011  dukedave@gmail.com
  * Don't print a "generated on" time in to .hs files produced by wxdirect
  As part of the changes to decrease the build time of wxHaskell, I'm going to
  modify all the writeFile calls in wxdirect such that they first check if
  their output is different from the current source file *before* they touch it.
  However if a date/time is written in to the file then the source will always
  be different; instead of writing an exception to this I motion that there is no
  need to be writing the date/time into the source anyway, that's what the file's
  meta-data is for.

darcs-hash:20120311125104-75908-502d3089a405e502673e2da4871af4c05adadbbd.gz
  • Loading branch information...
1 parent f8af539 commit e3be4b411c8bcad1529d782fdbff12188ef052a0 @jodonoghue committed Mar 11, 2012
@@ -103,7 +103,8 @@ compileClassInfo verbose moduleRoot moduleClassesName moduleClassTypesName modul
, ""
]
]
- prologue <- getPrologue moduleName "class info" (show defCount ++ " class info definitions.") []
+ prologue = getPrologue moduleName "class info"
+ (show defCount ++ " class info definitions.") []
putStrLn ("generating: " ++ outputFile)
writeFileLazy outputFile (unlines (prologue ++ export ++ classDefs ++ downcDefs))
@@ -33,23 +33,18 @@ compileClassTypes showIgnore moduleRoot moduleName outputFile inputFiles
classCount = length exportsClass
export = concat [ ["module " ++ moduleRoot ++ moduleName
- , " ( -- * Version"
- , " classTypesVersion"
- , " -- * Classes" ]
+ , " ( -- * Classes" ]
, exportsClassClasses
, [ " ) where"
, ""
, "import " ++ moduleRoot ++ "WxcObject"
- , ""
- , "classTypesVersion :: String"
- , "classTypesVersion = \"" ++ show time ++ "\""
, "" ]
]
- prologue <- getPrologue moduleName "class"
- (show classCount ++ " class definitions.")
- inputFiles
- let output = unlines (prologue ++ export ++ classDecls)
+ prologue = getPrologue moduleName "class"
+ (show classCount ++ " class definitions.")
+ inputFiles
+ output = unlines (prologue ++ export ++ classDecls)
putStrLn ("generating: " ++ outputFile)
writeFileLazy outputFile output
@@ -63,17 +58,17 @@ compileClassTypes showIgnore moduleRoot moduleName outputFile inputFiles
exportDefs :: [(ClassName,[String])] -> [String]
exportDefs classExports
= let classMap = Map.fromListWith (++) classExports
- in concatMap exportDef (Map.toAscList classMap)
+ in concatMap exportDef $ zip [0..] (Map.toAscList classMap)
where
- exportDef (className,exports)
- = [heading 2 className] ++ commaSep exports
+ exportDef (n, (className,exports))
+ = [heading 2 className] ++ (commaSep n) exports
- commaSep xs
- = map (exportComma++) xs
+ commaSep n xs
+ = zipWith (exportComma n) [0..] xs
heading i name
= exportSpaces ++ "-- " ++ replicate i '*' ++ " " ++ name
- exportComma = exportSpaces ++ ","
+ exportComma n m str = exportSpaces ++ (if n == 0 && m == 0 then " " else ",") ++ str
exportSpaces = " "
@@ -66,9 +66,9 @@ compileClasses showIgnore moduleRoot moduleClassTypesName moduleName outputFile
let methodCount = m1 + m2
classCount = c1 + c2
- prologue <- getPrologue moduleName "class"
- (show methodCount ++ " methods for " ++ show classCount ++ " classes.")
- inputFiles
+ prologue = getPrologue moduleName "class"
+ (show methodCount ++ " methods for " ++ show classCount ++ " classes.")
+ inputFiles
let output = unlines (prologue ++ export)
putStrLn ("generating: " ++ outputFile ++ ".hs")
@@ -107,10 +107,10 @@ compileClassesFile showIgnore moduleRoot moduleClassTypesName moduleName outputF
]
]
- prologue <- getPrologue moduleName "class"
- (show methodCount ++ " methods for " ++ show classCount ++ " classes.")
- inputFiles
- let output = unlines (ghcoptions ++ prologue ++ export ++ marshalDecls)
+ prologue = getPrologue moduleName "class"
+ (show methodCount ++ " methods for " ++ show classCount ++ " classes.")
+ inputFiles
+ output = unlines (ghcoptions ++ prologue ++ export ++ marshalDecls)
putStrLn ("generating: " ++ outputFile ++ ".hs")
writeFileLazy (outputFile ++ ".hs") output
@@ -1,81 +0,0 @@
------------------------------------------------------------------------------------------
-{-| Module : CompileDefs
- Copyright : (c) Daan Leijen 2003
- License : BSD-style
-
- Maintainer : wxhaskell-devel@lists.sourceforge.net
- Stability : provisional
- Portability : portable
-
- Module that compiles constant definitions to Haskell.
--}
------------------------------------------------------------------------------------------
-module CompileDefs( compileDefs ) where
-
-import Data.List( sortBy, sort )
-
-import Types
-import HaskellNames
-import ParseEiffel( parseEiffel )
-
-
-{-----------------------------------------------------------------------------------------
- Compile
------------------------------------------------------------------------------------------}
-compileDefs :: Bool -> String -> String -> FilePath -> [FilePath] -> IO ()
-compileDefs verbose moduleRoot moduleName outputFile inputFiles
- = do defss <- mapM parseEiffel inputFiles
- let defs = concat defss
- (haskellExports,haskellDefs) = unzip (map toHaskellDef defs)
-
- defCount = length defs
-
- export = concat [ ["module " ++ moduleRoot ++ moduleName
- , " ( -- * Types"
- , " BitFlag"
- , " -- * Constants"
- ]
- , map (exportComma++) haskellExports
- , [ " ) where"
- , ""
- , "-- | A flag can be combined with other flags to a bit mask."
- , "type BitFlag = Int"
- , ""
- ]
- ]
- prologue <- getPrologue moduleName "constant"
- (show defCount ++ " constant definitions.") inputFiles
-
- putStrLn ("generating: " ++ outputFile)
- writeFile outputFile (unlines (prologue ++ export ++ haskellDefs))
- putStrLn ("generated " ++ show defCount ++ " constant definitions")
- putStrLn "ok."
-
-cmpDef def1 def2
- = compare (defName def1) (defName def2)
-
-exportComma = exportSpaces ++ ","
-exportSpaces = " "
-
-
-{-----------------------------------------------------------------------------------------
-
------------------------------------------------------------------------------------------}
-toHaskellDef :: Def -> (String,String)
-toHaskellDef def
- = (haskellUnderscoreName (defName def)
- ,haskellUnderscoreName (defName def) ++ " :: " ++ haskellDefType def ++ "\n" ++
- haskellUnderscoreName (defName def) ++ " = " ++ haskellDefValue def ++ "\n"
- )
-
-haskellDefValue def
- = showNum (defValue def)
- where
- showNum x | x >= 0 = show x
- | otherwise = "(" ++ show x ++ ")"
-
-
-haskellDefType def
- = case defType def of
- DefInt -> "Int"
- DefMask -> "BitFlag"
@@ -26,6 +26,7 @@ import HaskellNames
import Classes( isClassName, classNames, classExtends )
import ParseC( parseC )
import DeriveTypes( deriveTypesAll, classifyName, Name(..), Method(..), ClassName, MethodName, PropertyName )
+import IOExtra
{-----------------------------------------------------------------------------------------
Compile
@@ -49,7 +50,7 @@ compileHeader showIgnore outputFile inputFiles
)
putStrLn ("generating: " ++ outputFile)
- writeFile outputFile output
+ writeFileLazy outputFile output
putStrLn ("generated " ++ show methodCount ++ " declarations.")
putStrLn ("ok.\n")
@@ -19,6 +19,7 @@ import Data.List
import Control.Monad
import Types
+import IOExtra
compileSTC :: Bool -- ^ Verbose
-> FilePath -- ^ Outputdir
@@ -32,9 +33,9 @@ compileSTC verbose outputDir inputs = do
h_target = outputDir ++ "include/stc_gen.h"
cpp_target = outputDir ++ "src/stc_gen.cpp"
putStrLn $ "generating: " ++ h_target
- writeFile h_target $ (glue "\n\n" $ map headerfunc f) ++ "\n"
+ writeFileLazy h_target $ (glue "\n\n" $ map headerfunc f) ++ "\n"
putStrLn $ "generating: " ++ cpp_target
- writeFile cpp_target $ (glue "\n" $ map cppfunc f) ++ "\n"
+ writeFileLazy cpp_target $ (glue "\n" $ map cppfunc f) ++ "\n"
when verbose $
putStrLn $ "Wrote type macros and c wrappers for " ++ show (length f) ++ " functions."
@@ -148,43 +148,37 @@ isBuiltin name
Haddock prologue
-----------------------------------------------------------------------------------------}
getPrologue moduleName content contains inputFiles
- = do time <- getCurrentTime
- return (prologue time)
+ = [line
+ ,"{-|\tModule : " ++ moduleName
+ ,"\tCopyright : Copyright (c) Daan Leijen 2003, 2004"
+ ,"\tLicense : wxWidgets"
+ ,""
+ ,"\tMaintainer : wxhaskell-devel@lists.sourceforge.net"
+ ,"\tStability : provisional"
+ ,"\tPortability : portable"
+ ,""
+ ,"Haskell " ++ content ++ " definitions for the wxWidgets C library (@wxc.dll@)."
+ ,""
+ ,"Do not edit this file manually!"
+ ,"This file was automatically generated by wxDirect."
+ ]
+ ++
+ (if (null inputFiles)
+ then []
+ else (["","From the files:"] ++ concatMap showFile inputFiles))
+ ++
+ [""
+ ,"And contains " ++ contains
+ ,"-}"
+ ,line
+ ]
where
- prologue time
- = [line
- ,"{-|\tModule : " ++ moduleName
- ,"\tCopyright : Copyright (c) Daan Leijen 2003, 2004"
- ,"\tLicense : wxWidgets"
- ,""
- ,"\tMaintainer : wxhaskell-devel@lists.sourceforge.net"
- ,"\tStability : provisional"
- ,"\tPortability : portable"
- ,""
- ,"Haskell " ++ content ++ " definitions for the wxWidgets C library (@wxc.dll@)."
- ,""
- ,"Do not edit this file manually!"
- ,"This file was automatically generated by wxDirect on: "
- , ""
- ," * @" ++ show time ++ "@"
- ]
- ++
- (if (null inputFiles)
- then []
- else (["","From the files:"] ++ concatMap showFile inputFiles))
- ++
- [""
- ,"And contains " ++ contains
- ,"-}"
- ,line
- ]
- where
- line = replicate 80 '-'
-
- showFile fname
- = [""," * @" ++ concatMap escapeSlash fname ++ "@"]
-
- escapeSlash c
- | c == '/' = "\\/"
- | c == '\"' = "\\\""
- | otherwise = [c]
+ line = replicate 80 '-'
+
+ showFile fname
+ = [""," * @" ++ concatMap escapeSlash fname ++ "@"]
+
+ escapeSlash c
+ | c == '/' = "\\/"
+ | c == '\"' = "\\\""
+ | otherwise = [c]
View
@@ -24,7 +24,6 @@ import System.Console.GetOpt
import CompileClasses ( compileClasses)
import CompileHeader ( compileHeader )
-import CompileDefs ( compileDefs )
import CompileClassTypes( compileClassTypes )
import CompileClassInfo ( compileClassInfo )
import CompileSTC ( compileSTC )
@@ -45,9 +44,6 @@ main
ModeClassTypes outputDir inputFiles verbose
-> compileClassTypes verbose moduleRootWxCore moduleClassTypesName
(outputDir ++ moduleClassTypesName ++ ".hs") inputFiles
- ModeDefs outputDir inputFiles verbose
- -> compileDefs verbose moduleRootWxCore moduleDefsName
- (outputDir ++ moduleDefsName ++ ".hs") inputFiles
ModeClassInfo outputDir verbose
-> compileClassInfo verbose moduleRootWxCore moduleClassesName moduleClassTypesName moduleClassInfoName
(outputDir ++ moduleClassInfoName ++ ".hs")
@@ -76,17 +72,7 @@ moduleRootDir moduleRoot
defaultOutputDirWxh
= "../wxcore/src/" ++ moduleRootDir moduleRootWxCore
-getDefaultFiles
- = do hs <- getDefaultHeaderFiles
- es <- getDefaultEiffelFiles
- return (hs++es)
-
-getDefaultEiffelFiles :: IO [FilePath]
-getDefaultEiffelFiles
- = do wxcdir <- getWxcDir
- return [wxcdir ++ "/include/wxc_defs.e"
- ,wxcdir ++ "/ewxw/eiffel/spec/r_2_4/wx_defs.e"]
-
+getDefaultFiles = getDefaultHeaderFiles
getDefaultHeaderFiles :: IO [FilePath]
getDefaultHeaderFiles
@@ -110,13 +96,12 @@ data Flag
data Target
- = TDefs | TClasses | TClassTypes | THeader | TClassInfo | TSTC
+ = TClasses | TClassTypes | THeader | TClassInfo | TSTC
data Mode
= ModeHelp
| ModeClasses { outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool }
| ModeClassTypes{ outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool }
- | ModeDefs { outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool }
| ModeClassInfo { outputDir :: FilePath, verbose :: Bool }
| ModeCHeader { outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool }
| ModeSTC { outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool }
@@ -136,8 +121,7 @@ isTarget _ = False
options :: [OptDescr Flag]
options =
- [ Option ['d'] ["definitions"] (NoArg (Target TDefs)) "generate constant definitions from .e files"
- , Option ['c'] ["classes"] (NoArg (Target TClasses)) "generate class method definitions from .h files"
+ [ Option ['c'] ["classes"] (NoArg (Target TClasses)) "generate class method definitions from .h files"
, Option ['t'] ["classtypes"] (NoArg (Target TClassTypes)) "generate class type definitions from .h files"
, Option ['i'] ["classinfo"] (NoArg (Target TClassInfo)) "generate class info definitions"
, Option ['h'] ["header"] (NoArg (Target THeader)) "generate typed C header file -- development use only"
@@ -158,10 +142,6 @@ compileOpts
then return ModeHelp
else case filter isTarget flags of
[] -> invokeError ["you need to specify a target: methods, definitions or classes.\n"]
- [Target TDefs] -> do defaultEiffelFiles <- getDefaultEiffelFiles
- inputFiles <- getInputFiles ".e" defaultEiffelFiles files
- outputDir <- getOutputDir flags defaultOutputDirWxh
- return (ModeDefs outputDir inputFiles (any isVerbose flags))
[Target TClassInfo]
-> do outputDir <- getOutputDir flags defaultOutputDirWxh
return (ModeClassInfo outputDir (any isVerbose flags))
@@ -236,4 +216,4 @@ helpMessage
return (usageInfo header options ++
"\ndefault input files:\n" ++
unlines (map (" "++) defaultFiles))
- where header = "usage: wxDirect -[dcti] [other options] [header-files..] [eiffel-files..]"
+ where header = "usage: wxDirect -[dcti] [other options] [header-files..]"
Oops, something went wrong.

0 comments on commit e3be4b4

Please sign in to comment.