# -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.158 2001/06/14 15:42:35 simonpj Exp $
+# $Id: Makefile,v 1.159 2001/06/15 08:29:57 simonpj Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
-I. -IcodeGen -InativeGen -Iparser \
-i$(subst $(space),:,$(DIRS))
+# We should do this, to avoid the use of an explicit path
+# in GHC source files (include "../includes/config.h"
+# But alas GHC 4.08 (and others for all I know) uses this very
+# same include path when compiling the .hc files it generates.
+# Disaster! Then the hc file sees the GHC 5.02 (or whatever)
+# include files. For the moment we've reverted to using
+# an explicit path in the .hs sources
+# -I$(GHC_INCLUDE_DIR) \
+
ifneq "$(mingw32_TARGET_OS)" "1"
SRC_HC_OPTS += -package concurrent -package posix -package text -package util
else
import Interpreter
import DriverPipeline
import CmTypes
-import CmStaticInfo ( GhciMode(..) )
+import HscTypes ( GhciMode(..) )
import Outputable ( SDoc )
import Digraph ( SCC(..), flattenSCC )
import Name ( Name )
+++ /dev/null
-%
-% (c) The University of Glasgow, 2000
-%
-\section[CmStaticInfo]{Session-static info for the Compilation Manager}
-
-\begin{code}
-module CmStaticInfo ( GhciMode(..), PackageConfig(..), defaultPackageConfig )
-where
-
-#include "HsVersions.h"
-
-\end{code}
-
-\begin{code}
-data GhciMode = Batch | Interactive | OneShot
- deriving Eq
-
-#include "../utils/ghc-pkg/Package.hs"
-\end{code}
import CmLink
import CmTypes
-import CmStaticInfo ( GhciMode(..) )
import DriverPipeline
import DriverFlags ( getDynFlags )
import DriverPhases
-----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.74 2001/06/14 12:50:06 simonpj Exp $
+-- $Id: InteractiveUI.hs,v 1.75 2001/06/15 08:29:57 simonpj Exp $
--
-- GHC Interactive User Interface
--
#include "HsVersions.h"
import CompManager
-import CmStaticInfo
+import HscTypes ( GhciMode(..) )
import ByteCodeLink
import DriverFlags
import DriverState
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.58 2001/06/14 12:50:06 simonpj Exp $
+-- $Id: DriverFlags.hs,v 1.59 2001/06/15 08:29:58 simonpj Exp $
--
-- Driver flags
--
) where
#include "HsVersions.h"
+#include "../includes/config.h"
import DriverState
import DriverUtil
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.78 2001/06/14 12:50:06 simonpj Exp $
+-- $Id: DriverPipeline.hs,v 1.79 2001/06/15 08:29:58 simonpj Exp $
--
-- GHC Driver
--
#include "HsVersions.h"
-import CmStaticInfo
+import Packages
import CmTypes
import GetImports
import DriverState
-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.44 2001/06/14 12:50:06 simonpj Exp $
+-- $Id: DriverState.hs,v 1.45 2001/06/15 08:29:58 simonpj Exp $
--
-- Settings for the driver
--
#include "../includes/config.h"
#include "HsVersions.h"
-import CmStaticInfo
+import Packages ( PackageConfig(..) )
import CmdLineOpts
import DriverUtil
import Util
#include "HsVersions.h"
import HscTypes ( ModuleLocation(..) )
-import CmStaticInfo
+import Packages ( PackageConfig(..) )
import DriverPhases
import DriverState
import Module
import Bag ( emptyBag )
import Outputable
import Interpreter
-import CmStaticInfo ( GhciMode(..) )
import HscStats ( ppSourceStats )
import HscTypes
import FiniteMap ( FiniteMap, plusFM, emptyFM, addToFM )
\begin{code}
module HscTypes (
+ GhciMode(..),
+
ModuleLocation(..),
ModDetails(..), ModIface(..),
%************************************************************************
%* *
+\subsection{Which mode we're in
+%* *
+%************************************************************************
+
+\begin{code}
+data GhciMode = Batch | Interactive | OneShot
+ deriving Eq
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection{Module locations}
%* *
%************************************************************************
{-# OPTIONS -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.71 2001/06/14 15:42:35 simonpj Exp $
+-- $Id: Main.hs,v 1.72 2001/06/15 08:29:58 simonpj Exp $
--
-- GHC Driver program
--
import Finder ( initFinder )
import CompManager ( cmInit, cmLoadModule )
-import CmStaticInfo ( GhciMode(..), PackageConfig(..) )
+import HscTypes ( GhciMode(..) )
import Config ( cBooterVersion, cGhcUnregisterised, cProjectVersion )
import SysTools ( packageConfigPath, initSysTools, cleanTempFiles )
-import ParsePkgConf ( parsePkgConf )
+import Packages ( showPackages, mungePackagePaths )
+import ParsePkgConf ( loadPackageConfig )
import DriverPipeline ( GhcMode(..), doLink, doMkDLL, genPipeline,
getGhcMode, pipeLoop, v_GhcMode
)
import Outputable
+import ErrUtils ( dumpIfSet )
import Util
import Panic ( GhcException(..), panic )
let (minusB_args, argv') = partition (prefixMatch "-B") argv
top_dir <- initSysTools minusB_args
- -- read the package configuration
- conf_file <- packageConfigPath
- r <- parsePkgConf conf_file
- case r of {
- Left err -> throwDyn (InstallationError (showSDoc err));
- Right pkg_details -> do
-
- writeIORef v_Package_details (mungePackagePaths top_dir pkg_details)
+ -- Read the package configuration
+ conf_file <- packageConfigPath
+ proto_pkg_details <- loadPackageConfig conf_file
+ let pkg_details = mungePackagePaths top_dir proto_pkg_details
+ writeIORef v_Package_details pkg_details
-- find the phase to stop after (i.e. -E, -C, -c, -S flags)
(flags2, mode, stop_flag) <- getGhcMode argv'
-- complain about any unknown flags
mapM unknownFlagErr [ f | f@('-':_) <- srcs ]
+ -- Display details of the configuration in verbose mode
verb <- dynFlag verbosity
when (verb >= 2)
when (verb >= 3)
(hPutStrLn stderr ("Hsc static flags: " ++ unwords static_opts))
+ showPackages pkg_details
+
-- initialise the finder
pkg_avails <- getPackageInfo
initFinder pkg_avails
when (mode == DoMkDependHS) endMkDependHS
when (mode == DoLink) (doLink o_files)
when (mode == DoMkDLL) (doMkDLL o_files)
- }
-
-
--- replace the string "$libdir" at the beginning of a path with the
--- current libdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
- where
- munge_pkg p = p{ import_dirs = munge_paths (import_dirs p),
- include_dirs = munge_paths (include_dirs p),
- library_dirs = munge_paths (library_dirs p) }
-
- munge_paths = map munge_path
- munge_path p
- | Just p' <- my_prefix_match "$libdir" p = top_dir ++ p'
- | otherwise = trace ("not: " ++ p) p
beginMake :: [String] -> IO ()
import RnMonad
import RnHsSyn ( RenamedInstDecl, RenamedTyClDecl )
import HscTypes ( VersionInfo(..), ModIface(..), ModDetails(..),
- ModuleLocation(..),
+ ModuleLocation(..), GhciMode(..),
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
TyThing(..), DFunId, Avails,
WhatsImported(..), GenAvailInfo(..),
ImportVersion, AvailInfo, Deprecations(..),
lookupVersion,
)
-import CmStaticInfo ( GhciMode(..) )
import CmdLineOpts
import Id ( idType, idInfo, isImplicitId, idCgInfo,
--- /dev/null
+%
+% (c) The University of Glasgow, 2000
+%
+\section{Package manipulation}
+
+\begin{code}
+module Packages ( PackageConfig(..),
+ defaultPackageConfig,
+ mungePackagePaths,
+ showPackages
+ )
+where
+
+#include "HsVersions.h"
+import Pretty
+
+import SysTools ( dosifyPath )
+import CmdLineOpts ( dynFlag, verbosity )
+import DriverUtil ( my_prefix_match )
+import ErrUtils ( dumpIfSet )
+import Outputable ( docToSDoc, trace )
+\end{code}
+
+\begin{code}
+#define WANT_PRETTY
+-- Yes, do generate pretty-printing stuff for packages
+
+-- There's a blob of code shared with ghc-pkg,
+-- so we just include it from there
+#include "../utils/ghc-pkg/Package.hs"
+\end{code}
+
+%*********************************************************
+%* *
+\subsection{Load the config file}
+%* *
+%*********************************************************
+
+\begin{code}
+mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
+-- a) replace the string "$libdir" at the beginning of a path with the
+-- current libdir (obtained from the -B option).
+-- b) dosify the paths [paths in the package-conf file aren't DOS style]
+mungePackagePaths top_dir ps = map munge_pkg ps
+ where
+ munge_pkg p = p{ import_dirs = munge_paths (import_dirs p),
+ include_dirs = munge_paths (include_dirs p),
+ library_dirs = munge_paths (library_dirs p) }
+
+ munge_paths = map munge_path
+
+ munge_path p
+ | Just p' <- my_prefix_match "$libdir" p = dosifyPath (top_dir ++ p')
+ | otherwise = trace ("not: " ++ p) p
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Display results}
+%* *
+%*********************************************************
+
+\begin{code}
+showPackages :: [PackageConfig] -> IO ()
+-- Show package info on console, if verbosity is >=2
+showPackages ps
+ = do { verb <- dynFlag verbosity
+ ; dumpIfSet (verb >= 2) "Packages"
+ (docToSDoc (vcat (map dumpPkgGuts ps)))
+ }
+\end{code}
{
-module ParsePkgConf (parsePkgConf) where
-import CmStaticInfo
+module ParsePkgConf( loadPackageConfig ) where
+
+import Packages ( PackageConfig(..), defaultPackageConfig )
import Lex
import FastString
import StringBuffer
import SrcLoc
import Outputable
+import Panic ( GhcException(..) )
+import Exception ( throwDyn )
+
#include "HsVersions.h"
+
}
%token
happyError :: P a
happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
-parsePkgConf :: FilePath -> IO (Either SDoc [PackageConfig])
-parsePkgConf conf_filename = do
+loadPackageConfig :: FilePath -> IO [PackageConfig]
+loadPackageConfig conf_filename = do
buf <- hGetStringBuffer False conf_filename
case parse buf PState{ bol = 0#, atbol = 1#,
context = [], glasgow_exts = 0#,
loc = mkSrcLoc (_PK_ conf_filename) 1 } of
PFailed err -> do
freeStringBuffer buf
- return (Left err)
+ throwDyn (InstallationError (showSDoc err))
POk _ pkg_details -> do
freeStringBuffer buf
- return (Right pkg_details)
+ return pkg_details
}
-- Misc
showGhcUsage, -- IO () Shows usage message and exits
getSysMan, -- IO String Parallel system only
+ dosifyPath, -- String -> String
runSomething -- ToDo: make private
) where
#if !defined(mingw32_TARGET_OS)
import qualified Posix
#else
-import Ptr ( nullPtr )
+import Addr ( nullAddr )
#endif
#include "HsVersions.h"
p1 = dropWhile (not . isSlash) (reverse dir)
p2 = dropWhile (not . isSlash) (tail p1) -- head is '/'
top_dir = reverse (tail p2) -- head is '/'
-
-getExecDir = return Nothing
\end{code}
-----------------------------------------------------------------------------
-- Define myGetProcessId :: IO Int
+-- getExecDir :: IO (Maybe String)
#ifdef mingw32_TARGET_OS
foreign import "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
-foreign import stdcall "GetCurrentDirectoryA" getCurrentDirectory :: Int32 -> CString -> IO Int32
+
getExecDir :: IO (Maybe String)
-getExecDir = do len <- getCurrentDirectory 0 nullPtr
+getExecDir = return Nothing
+{-
+foreign import stdcall "GetCurrentDirectoryA" getCurrentDirectory :: Int32 -> CString -> IO Int32
+getExecDir = do len <- getCurrentDirectory 0 nullAddr
buf <- mallocArray (fromIntegral len)
ret <- getCurrentDirectory len buf
if ret == 0 then return Nothing
else do s <- peekCString buf
destructArray (fromIntegral len) buf
return (Just s)
+-}
#else
getProcessID :: IO Int
getProcessID = Posix.getProcessID
GlobalRdrEnv, GlobalRdrElt(..), pprGlobalRdrEnv,
AvailEnv, GenAvailInfo(..), AvailInfo,
Provenance(..), ImportReason(..), initialVersionInfo,
- Deprecations(..),
+ Deprecations(..), GhciMode(..),
LocalRdrEnv
)
-import CmStaticInfo ( GhciMode(..) )
import List ( partition, nub )
\end{code}
ifPprDebug, unqualStyle,
SDoc, -- Abstract
+ docToSDoc,
interppSP, interpp'SP, pprQuotedList, pprWithCommas,
empty, nest,
text, char, ptext,
\end{code}
\begin{code}
+docToSDoc :: Doc -> SDoc
+docToSDoc d = \_ -> d
+
empty sty = Pretty.empty
text s sty = Pretty.text s
char c sty = Pretty.char c
projects / ghc-hetmet.git / commitdiff