diff --git a/configure.ac b/configure.ac index 77d8989..5f07864 100644 --- a/configure.ac +++ b/configure.ac @@ -42,11 +42,13 @@ fi AC_SUBST(WHOLE_ARCHIVE_FLAG) AC_SUBST(LEADING_UNDERSCORE) -if test "$build-os" = "cygwin" +if test "$build_os" = "cygwin" then LEADING_UNDERSCORE=1 + SYMS="$SYMS -DCYGWIN" fi AC_SUBST(LEADING_UNDERSCORE) +AC_SUBST(SYMS) # Find pwd, in a cygwin friendly way. # Suggested by: http://www.haskell.org/ghc/docs/latest/html/users_guide/ch11s04.html diff --git a/src/plugins/Plugins/Consts.hs b/src/plugins/Plugins/Consts.hs index cd3a292..76e78fc 100644 --- a/src/plugins/Plugins/Consts.hs +++ b/src/plugins/Plugins/Consts.hs @@ -40,6 +40,11 @@ sysPkgSuffix = ".o" objSuf = sysPkgSuffix hiSuf = ".hi" hsSuf = ".hs" +#ifdef CYGWIN +dllSuf = ".dll" +#else +dllSuf = ".so" +#endif -- | The prefix used by system modules. This, in conjunction with -- 'systemModuleExtension', will result in a module filename that looks diff --git a/src/plugins/Plugins/Env.hs b/src/plugins/Plugins/Env.hs index 2959e01..6c23675 100644 --- a/src/plugins/Plugins/Env.hs +++ b/src/plugins/Plugins/Env.hs @@ -49,7 +49,7 @@ import Plugins.ParsePkgConfCabal( parsePkgConf ) #else import Plugins.ParsePkgConfLite ( parsePkgConf ) #endif -import Plugins.Consts ( ghcLibraryPath, sysPkgConf, sysPkgSuffix ) +import Plugins.Consts ( ghcLibraryPath, sysPkgConf, sysPkgSuffix, dllSuf ) import Data.IORef ( writeIORef, readIORef, newIORef, IORef() ) import Data.Maybe ( isJust ) @@ -57,6 +57,11 @@ import Data.List ( isPrefixOf, nub ) import System.IO.Unsafe ( unsafePerformIO ) import System.Directory ( doesFileExist ) +#ifdef CYGWIN +import System.Environment ( getEnv ) + +import Control.Monad ( liftM ) +#endif 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 Just package -> do +#ifdef CYGWIN + let libdirs = fix_topdir $ libraryDirs package +#else let libdirs = libraryDirs package +#endif hslibs = hsLibraries package extras = extraLibraries package deppkgs = packageDeps package - libs <- mapM (findHSlib $ fix_topdir libdirs) (hslibs ++ extras) - libs' <- mapM (findDLL $ "C:/WINDOWS/SYSTEM") extras - + libs <- mapM (findHSlib libdirs) (hslibs ++ 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 -- means that they refer to system libraries. Can't do -- anything about that. return (deppkgs, (filterJust libs,filterJust libs') ) +#ifdef CYGWIN -- replace $topdir fix_topdir [] = [] 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) | otherwise = '$' : replace_topdir xs replace_topdir (x:xs) = x : replace_topdir xs - +#endif -- a list elimination form for the Maybe type filterJust :: [Maybe a] -> [a] filterJust [] = [] @@ -346,12 +360,13 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p if b then return $ Just l -- found it! else findHSlib dirs lib - findDLL :: FilePath -> String -> IO (Maybe FilePath) - findDLL dir lib = do - let l = dir ++ "/" ++ lib ++ ".dll" + findDLL :: [FilePath] -> String -> IO (Maybe FilePath) + findDLL [] _ = return Nothing + findDLL (dir:dirs) lib = do + let l = dir lib ++ dllSuf b <- doesFileExist l if b then return $ Just l - else return $ Nothing + else findDLL dirs lib ------------------------------------------------------------------------ -- do we have a Module name for this merge? diff --git a/src/plugins/Plugins/MkTemp.hs b/src/plugins/Plugins/MkTemp.hs index e75fc0d..34279cc 100644 --- a/src/plugins/Plugins/MkTemp.hs +++ b/src/plugins/Plugins/MkTemp.hs @@ -97,9 +97,8 @@ gettemp path doopen domkdir slen = do -- -- replace end of template with process id, and rest with randomness -- - ;pid <- liftM show $ abs `fmap` getProcessID - -- getProcessID returns a negative number? why, dunno, but the minus - -- sign screws up Module header names, illegal char. + ;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. +-- ;pid <- liftM show $ getProcessID ;let (rest, xs) = merge tmpl pid ;as <- randomise rest ;let tmpl' = as ++ xs @@ -244,8 +243,12 @@ mkdir0700 dir = createDirectory dir foreign import ccall unsafe "_getpid" getProcessID :: IO Int #else getProcessID :: IO Int +#ifdef CYGWIN +getProcessID = System.Posix.Internals.c_getpid >>= return . abs . fromIntegral +#else getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral #endif +#endif -- --------------------------------------------------------------------- -- | Use a variety of random functions, if you like.