[project @ 2001-07-05 13:31:09 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / SysTools.lhs
index 7e6a0f1..33ac91c 100644 (file)
@@ -120,6 +120,30 @@ Config.hs contains two sorts of things
                
 
 
+---------------------------------------------
+NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
+
+Another hair-brained scheme for simplifying the current tool location
+nightmare in GHC: Simon originally suggested using another
+configuration file along the lines of GCC's specs file - which is fine
+except that it means adding code to read yet another configuration
+file.  What I didn't notice is that the current package.conf is
+general enough to do this:
+
+Package
+    {name = "tools",    import_dirs = [],  source_dirs = [],
+     library_dirs = [], hs_libraries = [], extra_libraries = [],
+     include_dirs = [], c_includes = [],   package_deps = [],
+     extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${libdir}/bin/unlit", ... etc.],
+     extra_cc_opts = [], extra_ld_opts = []}
+
+Which would have the advantage that we get to collect together in one
+place the path-specific package stuff with the path-specific tool
+stuff.
+               End of NOTES
+---------------------------------------------
+
+
 %************************************************************************
 %*                                                                     *
 \subsection{Global variables to contain system programs}
@@ -173,7 +197,8 @@ initSysTools minusB_args
                --      for "in-place" it is the root of the build tree
                -- NB: top_dir is assumed to be in standard Unix format '/' separated
 
-       ; let installed_bin pgm   =  pgmPath (top_dir `slash` "bin") pgm
+       ; let installed, installed_bin :: FilePath -> FilePath
+              installed_bin pgm   =  pgmPath (top_dir `slash` "extra-bin") pgm
              installed     file  =  pgmPath top_dir file
              inplace dir   pgm   =  pgmPath (top_dir `slash` dir) pgm
 
@@ -212,15 +237,23 @@ initSysTools minusB_args
        --      so when "installed" we look in TopDir/bin
        -- When "in-place" we look wherever the build-time configure 
        --      script found them
-       ; let cpp_path  | am_installed = installed cRAWCPP
-                       | otherwise    = cRAWCPP
-             gcc_path  | am_installed = installed cGCC
+       -- When "install" we tell gcc where its specs file + exes are (-B)
+       --      and also some places to pick up include files.  We need
+       --      to be careful to put all necessary exes in the -B place
+       --      (as, ld, cc1, etc) since if they don't get found there, gcc
+       --      then tries to run unadorned "as", "ld", etc, and will
+       --      pick up whatever happens to be lying around in the path,
+       --      possibly including those from a cygwin install on the target,
+       --      which is exactly what we're trying to avoid.
+       ; let gcc_path  | am_installed = installed_bin ("gcc -B" ++ installed "lib/gcc-lib/" 
+                                         ++ " -I" ++ installed "include/w32api:" 
+                                                  ++ installed "include/mingw")
                        | otherwise    = cGCC
-             perl_path | am_installed = installed cGHC_PERL
+             perl_path | am_installed = installed_bin cGHC_PERL
                        | otherwise    = cGHC_PERL
 
        -- 'touch' is a GHC util for Windows, and similarly unlit, mangle
-       ; let touch_path  | am_installed = installed cGHC_TOUCHY
+       ; let touch_path  | am_installed = installed_bin cGHC_TOUCHY
                          | otherwise    = inplace cGHC_TOUCHY_DIR cGHC_TOUCHY
 
        -- On Win32 we don't want to rely on #!/bin/perl, so we prepend 
@@ -234,8 +267,7 @@ initSysTools minusB_args
        -- On Unix, the "standard" tools are assumed to be
        -- in the same place whether we are running "in-place" or "installed"
        -- That place is wherever the build-time configure script found them.
-       ; let   cpp_path   = cRAWCPP
-               gcc_path   = cGCC
+       ; let   gcc_path   = cGCC
                touch_path = cGHC_TOUCHY
                mkdll_path = panic "Can't build DLLs on a non-Win32 system"
 
@@ -245,9 +277,11 @@ initSysTools minusB_args
        -- our knowledge of $(PERL) on the host system here.
        ; let split_path  = split_script
              mangle_path = mangle_script
-
 #endif
 
+       -- cpp is derived from gcc on all platforms
+        ; let cpp_path  = gcc_path ++ " -E " ++ cRAWCPP_FLAGS
+
        -- For all systems, copy and remove are provided by the host
        -- system; architecture-specific stuff is done when building Config.hs
        ; let   cp_path = cGHC_CP
@@ -325,9 +359,6 @@ getTopDir :: [String]
 
 getTopDir minusbs
   = do { top_dir <- get_proto
-       ; print top_dir
-       ; if "/ghc/compiler" `isSuffixOf` top_dir then print (remove_suffix top_dir) else print "not"
-
         -- Discover whether we're running in a build tree or in an installation,
        -- by looking for the package configuration file.
        ; am_installed <- doesFileExist (top_dir `slash` "package.conf")
@@ -408,14 +439,15 @@ touch purpose arg =  do p <- readIORef v_Pgm_T
                        runSomething purpose p [arg]
 
 copy :: String -> String -> String -> IO ()
-copy purpose from to =
-    (do
-      h <- openFile to WriteMode
-      ls <- readFile from -- inefficient, but it'll do for now.
-                             -- ToDo: speed up via slurping.
-      hPutStrLn h ls
-      hClose h) `catchAllIO`
-                (\_ -> throwDyn (PhaseFailed purpose (ExitFailure 1)))
+copy purpose from to = do
+  verb <- dynFlag verbosity
+  when (verb >= 2) $ hPutStrLn stderr ("*** " ++ purpose)
+
+  h <- openFile to WriteMode
+  ls <- readFile from -- inefficient, but it'll do for now.
+                     -- ToDo: speed up via slurping.
+  hPutStr h ls
+  hClose h
 \end{code}
 
 \begin{code}
@@ -497,9 +529,11 @@ removeTmpFiles verb fs
             ("Deleting: " ++ unwords fs)
             (mapM_ rm fs)
   where
-    rm f = removeFile f `catchAllIO`
-               (\exn -> hPutStrLn stderr ("Warning: deleting non-existent " ++ f) >>
-                        return ())
+    rm f = removeFile f `catchAllIO` 
+               (\_ignored -> 
+                   when (verb >= 2) $
+                     hPutStrLn stderr ("Warning: deleting non-existent " ++ f)
+               )
 
 \end{code}