tidy-cygwin-modifications

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

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

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?

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.