tidy-cygwin-modifications

This commit is contained in:
vivian.mcphail 2005-05-07 08:07:34 +00:00
parent 6e8f0dc68f
commit d431902833
4 changed files with 38 additions and 13 deletions

View File

@ -42,11 +42,13 @@ fi
AC_SUBST(WHOLE_ARCHIVE_FLAG) AC_SUBST(WHOLE_ARCHIVE_FLAG)
AC_SUBST(LEADING_UNDERSCORE) AC_SUBST(LEADING_UNDERSCORE)
if test "$build-os" = "cygwin" if test "$build_os" = "cygwin"
then then
LEADING_UNDERSCORE=1 LEADING_UNDERSCORE=1
SYMS="$SYMS -DCYGWIN"
fi fi
AC_SUBST(LEADING_UNDERSCORE) AC_SUBST(LEADING_UNDERSCORE)
AC_SUBST(SYMS)
# Find pwd, in a cygwin friendly way. # Find pwd, in a cygwin friendly way.
# Suggested by: http://www.haskell.org/ghc/docs/latest/html/users_guide/ch11s04.html # Suggested by: http://www.haskell.org/ghc/docs/latest/html/users_guide/ch11s04.html

View File

@ -40,6 +40,11 @@ sysPkgSuffix = ".o"
objSuf = sysPkgSuffix objSuf = sysPkgSuffix
hiSuf = ".hi" hiSuf = ".hi"
hsSuf = ".hs" hsSuf = ".hs"
#ifdef CYGWIN
dllSuf = ".dll"
#else
dllSuf = ".so"
#endif
-- | The prefix used by system modules. This, in conjunction with -- | The prefix used by system modules. This, in conjunction with
-- 'systemModuleExtension', will result in a module filename that looks -- 'systemModuleExtension', will result in a module filename that looks

View File

@ -49,7 +49,7 @@ import Plugins.ParsePkgConfCabal( parsePkgConf )
#else #else
import Plugins.ParsePkgConfLite ( parsePkgConf ) import Plugins.ParsePkgConfLite ( parsePkgConf )
#endif #endif
import Plugins.Consts ( ghcLibraryPath, sysPkgConf, sysPkgSuffix ) import Plugins.Consts ( ghcLibraryPath, sysPkgConf, sysPkgSuffix, dllSuf )
import Data.IORef ( writeIORef, readIORef, newIORef, IORef() ) import Data.IORef ( writeIORef, readIORef, newIORef, IORef() )
import Data.Maybe ( isJust ) import Data.Maybe ( isJust )
@ -57,6 +57,11 @@ import Data.List ( isPrefixOf, nub )
import System.IO.Unsafe ( unsafePerformIO ) import System.IO.Unsafe ( unsafePerformIO )
import System.Directory ( doesFileExist ) import System.Directory ( doesFileExist )
#ifdef CYGWIN
import System.Environment ( getEnv )
import Control.Monad ( liftM )
#endif
import Control.Concurrent.MVar ( MVar(), newMVar, withMVar ) import Control.Concurrent.MVar ( MVar(), newMVar, withMVar )
@ -305,18 +310,27 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
Nothing -> go fms q -- look in other pkgs Nothing -> go fms q -- look in other pkgs
Just package -> do Just package -> do
#ifdef CYGWIN
let libdirs = fix_topdir $ libraryDirs package
#else
let libdirs = libraryDirs package let libdirs = libraryDirs package
#endif
hslibs = hsLibraries package hslibs = hsLibraries package
extras = extraLibraries package extras = extraLibraries package
deppkgs = packageDeps package deppkgs = packageDeps package
libs <- mapM (findHSlib $ fix_topdir libdirs) (hslibs ++ extras) libs <- mapM (findHSlib libdirs) (hslibs ++ extras)
libs' <- mapM (findDLL $ "C:/WINDOWS/SYSTEM") extras #ifdef CYGWIN
syslibdir <- liftM ( \x -> x ++ "/SYSTEM") (getEnv "SYSTEMROOT")
libs' <- mapM (findDLL $ syslibdir : libdirs) extras
#else
libs' <- mapM (findDLL libdirs) extras
#endif
-- don't care if there are 'Nothings', that usually -- don't care if there are 'Nothings', that usually
-- means that they refer to system libraries. Can't do -- means that they refer to system libraries. Can't do
-- anything about that. -- anything about that.
return (deppkgs, (filterJust libs,filterJust libs') ) return (deppkgs, (filterJust libs,filterJust libs') )
#ifdef CYGWIN
-- replace $topdir -- replace $topdir
fix_topdir [] = [] fix_topdir [] = []
fix_topdir (x:xs) = replace_topdir x : fix_topdir xs fix_topdir (x:xs) = replace_topdir x : fix_topdir xs
@ -326,7 +340,7 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
| take 6 xs == "topdir" = ghcLibraryPath ++ (drop 6 xs) | take 6 xs == "topdir" = ghcLibraryPath ++ (drop 6 xs)
| otherwise = '$' : replace_topdir xs | otherwise = '$' : replace_topdir xs
replace_topdir (x:xs) = x : replace_topdir xs replace_topdir (x:xs) = x : replace_topdir xs
#endif
-- a list elimination form for the Maybe type -- a list elimination form for the Maybe type
filterJust :: [Maybe a] -> [a] filterJust :: [Maybe a] -> [a]
filterJust [] = [] filterJust [] = []
@ -346,12 +360,13 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
if b then return $ Just l -- found it! if b then return $ Just l -- found it!
else findHSlib dirs lib else findHSlib dirs lib
findDLL :: FilePath -> String -> IO (Maybe FilePath) findDLL :: [FilePath] -> String -> IO (Maybe FilePath)
findDLL dir lib = do findDLL [] _ = return Nothing
let l = dir ++ "/" ++ lib ++ ".dll" findDLL (dir:dirs) lib = do
let l = dir </> lib ++ dllSuf
b <- doesFileExist l b <- doesFileExist l
if b then return $ Just l if b then return $ Just l
else return $ Nothing else findDLL dirs lib
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- do we have a Module name for this merge? -- do we have a Module name for this merge?

View File

@ -97,9 +97,8 @@ gettemp path doopen domkdir slen = do
-- --
-- replace end of template with process id, and rest with randomness -- replace end of template with process id, and rest with randomness
-- --
;pid <- liftM show $ abs `fmap` getProcessID ;pid <- liftM show $ do {v <- getProcessID ; return $ abs v} -- getProcessID returns a negative number? why, dunno, but the minus sign screws up Module header names, illegal char.
-- getProcessID returns a negative number? why, dunno, but the minus -- ;pid <- liftM show $ getProcessID
-- sign screws up Module header names, illegal char.
;let (rest, xs) = merge tmpl pid ;let (rest, xs) = merge tmpl pid
;as <- randomise rest ;as <- randomise rest
;let tmpl' = as ++ xs ;let tmpl' = as ++ xs
@ -244,8 +243,12 @@ mkdir0700 dir = createDirectory dir
foreign import ccall unsafe "_getpid" getProcessID :: IO Int foreign import ccall unsafe "_getpid" getProcessID :: IO Int
#else #else
getProcessID :: IO Int getProcessID :: IO Int
#ifdef CYGWIN
getProcessID = System.Posix.Internals.c_getpid >>= return . abs . fromIntegral
#else
getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
#endif #endif
#endif
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- | Use a variety of random functions, if you like. -- | Use a variety of random functions, if you like.