From: sewardj Date: Fri, 27 Oct 2000 11:48:56 +0000 (+0000) Subject: [project @ 2000-10-27 11:48:54 by sewardj] X-Git-Tag: Approximately_9120_patches~3491 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=fd99cf4f7c390e4b1abc9a839a6f023d3b6c4757;p=ghc-hetmet.git [project @ 2000-10-27 11:48:54 by sewardj] Track changes to the finder (now is a global variable and not passed around). Also some fixes to flag handling. --- diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index 3ee053b..7143701 100644 --- a/ghc/compiler/Makefile +++ b/ghc/compiler/Makefile @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Makefile,v 1.97 2000/10/27 09:39:35 sewardj Exp $ +# $Id: Makefile,v 1.98 2000/10/27 11:48:54 sewardj Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk @@ -207,7 +207,9 @@ nativeGen/MachCode_HC_OPTS = -H10m usageSP/UsageSPInf_HC_OPTS = -Onot prelude/PrimOp_HC_OPTS = -H12m -K3m -prelude/PrelRules_HC_OPTS = + +# because the NCG can't handle the 64-bit math in here +prelude/PrelRules_HC_OPTS = -fvia-C parser/Lex_HC_OPTS = -K2m -H16m parser/Ctype_HC_OPTS = -K2m diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index a678e34..d254ab1 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -100,7 +100,6 @@ module CmdLineOpts ( import Array ( array, (//) ) import GlaExts import IOExts ( IORef, readIORef ) -import Argv import Constants -- Default values for some flags import Util import FastTypes diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 284ea8e..8e7ac15 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.9 2000/10/26 16:21:02 sewardj Exp $ +-- $Id: DriverFlags.hs,v 1.10 2000/10/27 11:48:55 sewardj Exp $ -- -- Driver flags -- @@ -61,13 +61,14 @@ data OptKind processArgs :: [(String,OptKind)] -> [String] -> [String] -> IO [String] -- returns spare args processArgs _spec [] spare = return (reverse spare) -processArgs spec args@(arg@('-':_):args') spare = do +processArgs spec args@(('-':arg):args') spare = do + putStrLn ( "processArg: " ++ arg) case findArg spec arg of Just (rest,action) -> do args' <- processOneArg action rest args processArgs spec args' spare Nothing -> - processArgs spec args' (arg:spare) + processArgs spec args' (('-':arg):spare) processArgs spec (arg:args) spare = processArgs spec args (arg:spare) @@ -114,9 +115,10 @@ processOneArg action rest (dash_arg@('-':arg):args) = findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind) findArg spec arg - = case [ (remove_spaces rest, k) + = trace ("findArg: " ++ arg) $ + case [ (remove_spaces rest, k) | (pat,k) <- spec, Just rest <- [my_prefix_match pat arg], - arg_ok k arg rest ] + arg_ok k rest arg ] of [] -> Nothing (one:_) -> Just one diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 022b707..06735fe 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPipeline.hs,v 1.8 2000/10/26 16:21:02 sewardj Exp $ +-- $Id: DriverPipeline.hs,v 1.9 2000/10/27 11:48:55 sewardj Exp $ -- -- GHC Driver -- @@ -30,7 +30,6 @@ import DriverMkDepend import DriverPhases import DriverFlags import HscMain -import Finder import TmpFiles import HscTypes import Outputable @@ -391,6 +390,8 @@ run_phase MkDependHS basename suff input_fn _output_fn = do ----------------------------------------------------------------------------- -- Hsc phase +-- Compilation of a single module, in "legacy" mode (_not_ under +-- the direction of the compilation manager). run_phase Hsc basename suff input_fn output_fn = do @@ -436,6 +437,8 @@ run_phase Hsc basename suff input_fn output_fn -- build a bogus ModSummary to pass to hscMain. let summary = ModSummary { + ms_mod = (mkModuleInThisPackage . mkModuleName) + {-ToDo: modname!!-}basename, ms_location = error "no loc", ms_ppsource = Just (input_fn, error "no fingerprint"), ms_imports = error "no imports" @@ -447,7 +450,6 @@ run_phase Hsc basename suff input_fn output_fn -- run the compiler! pcs <- initPersistentCompilerState result <- hscMain dyn_flags{ hscOutName = output_fn } - (error "no Finder!") summary Nothing -- no iface emptyModuleEnv -- HomeSymbolTable @@ -689,8 +691,9 @@ preprocess filename = do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") filename runPipeline pipeline filename False{-no linking-} False{-no -o flag-} + ----------------------------------------------------------------------------- --- Compile a single module. +-- Compile a single module, under the control of the compilation manager. -- -- This is the interface between the compilation manager and the -- compiler proper (hsc), where we deal with tedious details like @@ -703,8 +706,7 @@ preprocess filename = -- the .hs file if necessary, and compiling up the .stub_c files to -- generate Linkables. -compile :: Finder -- to find modules - -> ModSummary -- summary, including source +compile :: ModSummary -- summary, including source -> Maybe ModIface -- old interface, if available -> HomeSymbolTable -- for home module ModDetails -> HomeIfaceTable -- for home module Ifaces @@ -721,7 +723,7 @@ data CompResult | CompErrs PersistentCompilerState -- updated PCS -compile finder summary old_iface hst hit pcs = do +compile summary old_iface hst hit pcs = do verb <- readIORef v_Verbose when verb (hPutStrLn stderr (showSDoc (text "compile: compiling" @@ -749,7 +751,7 @@ compile finder summary old_iface hst hit pcs = do -- run the compiler hsc_result <- hscMain dyn_flags{ hscOutName = output_fn } - finder summary old_iface hst hit pcs + summary old_iface hst hit pcs case hsc_result of { HscFail pcs -> return (CompErrs pcs); diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 13c665b..501dbd0 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -5,7 +5,7 @@ \begin{code} module Finder ( - newFinder, -- :: PackageConfigInfo -> IO (), + initFinder, -- :: PackageConfigInfo -> IO (), findModule, -- :: ModuleName -> IO (Maybe (Module, ModuleLocation)) ModuleLocation(..), mkHomeModuleLocn, @@ -43,8 +43,8 @@ GLOBAL_VAR(v_PkgDirCache, error "no pkg cache!", FiniteMap String (PackageNa GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath)) -newFinder :: PackageConfigInfo -> IO () -newFinder (PackageConfigInfo pkgs) = do +initFinder :: PackageConfigInfo -> IO () +initFinder (PackageConfigInfo pkgs) = do -- expunge our home cache writeIORef v_HomeDirCache Nothing @@ -52,8 +52,8 @@ newFinder (PackageConfigInfo pkgs) = do writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs)) -findModule :: [Package] -> ModuleName -> IO (Maybe (Module, ModuleLocation)) -findModule pkgs name = do +findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation)) +findModule name = do j <- maybeHomeModule name case j of Just home_module -> return (Just home_module) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index b61356c..ab35159 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -66,7 +66,6 @@ import HscTypes ( ModDetails, ModIface(..), PersistentCompilerState(..), import RnMonad ( ExportItem, ParsedIface(..) ) import CmSummarise ( ModSummary(..), name_of_summary, ms_get_imports, mimp_name ) -import Finder ( Finder ) import InterpSyn ( UnlinkedIBind ) import StgInterp ( ItblEnv ) import FiniteMap ( FiniteMap, plusFM, emptyFM, addToFM ) @@ -100,7 +99,6 @@ data HscResult hscMain :: DynFlags - -> Finder -> ModSummary -- summary, including source filename -> Maybe ModIface -- old interface, if available -> HomeSymbolTable -- for home module ModDetails @@ -108,13 +106,13 @@ hscMain -> PersistentCompilerState -- IN: persistent compiler state -> IO HscResult -hscMain dflags finder summary maybe_old_iface hst hit pcs +hscMain dflags summary maybe_old_iface hst hit pcs = do { -- ????? source_unchanged :: Bool -- extracted from summary? let source_unchanged = trace "WARNING: source_unchanged?!" False ; (pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface)) - <- checkOldIface dflags finder hit hst pcs (ms_mod summary) + <- checkOldIface dflags hit hst pcs (ms_mod summary) source_unchanged maybe_old_iface; if check_errs then return (HscFail pcs_ch) @@ -124,12 +122,12 @@ hscMain dflags finder summary maybe_old_iface hst hit pcs what_next | recomp_reqd || no_old_iface = hscRecomp | otherwise = hscNoRecomp ; - what_next dflags finder summary maybe_checked_iface + what_next dflags summary maybe_checked_iface hst hit pcs_ch }} -hscNoRecomp dflags finder summary maybe_checked_iface hst hit pcs_ch +hscNoRecomp dflags summary maybe_checked_iface hst hit pcs_ch = do { -- we definitely expect to have the old interface available let old_iface = case maybe_checked_iface of @@ -138,7 +136,7 @@ hscNoRecomp dflags finder summary maybe_checked_iface hst hit pcs_ch ; -- CLOSURE (pcs_cl, closure_errs, cl_hs_decls) - <- closeIfaceDecls dflags finder hit hst pcs_ch old_iface ; + <- closeIfaceDecls dflags hit hst pcs_ch old_iface ; if closure_errs then return (HscFail pcs_cl) else do { @@ -167,7 +165,7 @@ hscNoRecomp dflags finder summary maybe_checked_iface hst hit pcs_ch }}}} -hscRecomp dflags finder summary maybe_checked_iface hst hit pcs_ch +hscRecomp dflags summary maybe_checked_iface hst hit pcs_ch = do { -- what target are we shooting for? let toInterp = dopt_HscLang dflags == HscInterpreted @@ -182,7 +180,7 @@ hscRecomp dflags finder summary maybe_checked_iface hst hit pcs_ch -- RENAME show_pass dflags "Renamer"; (pcs_rn, maybe_rn_result) - <- renameModule dflags finder hit hst pcs_ch this_mod rdr_module; + <- renameModule dflags hit hst pcs_ch this_mod rdr_module; case maybe_rn_result of { Nothing -> return (HscFail pcs_rn); Just (new_iface, rn_hs_decls) -> do { @@ -221,7 +219,7 @@ hscRecomp dflags finder summary maybe_checked_iface hst hit pcs_ch Just (fif, sdoc) -> Just fif; Nothing -> Nothing ; -- Write the interface file - writeIface finder maybe_final_iface + writeIface maybe_final_iface ; -- do the rest of code generation/emission (maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds) diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index de1c5aa..1b119c4 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -5,7 +5,7 @@ \begin{code} module HscTypes ( - Finder, ModuleLocation(..), + ModuleLocation(..), ModDetails(..), ModIface(..), GlobalSymbolTable, HomeSymbolTable, PackageSymbolTable, @@ -80,13 +80,11 @@ import UniqSupply ( UniqSupply ) %************************************************************************ %* * -\subsection{The Finder type} +\subsection{Module locations} %* * %************************************************************************ \begin{code} -type Finder = ModuleName -> IO (Maybe (Module, ModuleLocation)) - data ModuleLocation = ModuleLocation { hs_file :: FilePath, diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index e3e58f0..9e91f96 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,6 +1,6 @@ {-# OPTIONS -W -fno-warn-incomplete-patterns #-} ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.11 2000/10/26 16:51:44 sewardj Exp $ +-- $Id: Main.hs,v 1.12 2000/10/27 11:48:55 sewardj Exp $ -- -- GHC Driver program -- @@ -23,6 +23,8 @@ import DriverUtil import DriverPhases ( Phase(..) ) import CmdLineOpts ( HscLang(..), DynFlags(..), v_Static_hsc_opts ) import TmpFiles +import Finder ( initFinder ) +import CmStaticInfo ( mkPCI ) import Config import Util import Panic @@ -42,7 +44,6 @@ import List import System import Maybe -import CompManager ----------------------------------------------------------------------------- -- Changes: @@ -114,7 +115,7 @@ main = argv' <- setTopDir argv top_dir <- readIORef v_TopDir - let installed s = top_dir ++ s + let installed s = top_dir ++ '/':s inplace s = top_dir ++ '/':cCURRENT_DIR ++ '/':s installed_pkgconfig = installed ("package.conf") @@ -210,6 +211,11 @@ main = when verb (hPutStrLn stderr ("Using package config file: " ++ conf_file)) + -- initialise the finder + pkg_details <- readIORef v_Package_details + pci <- mkPCI pkg_details + initFinder pci + -- mkdependHS is special when (mode == DoMkDependHS) beginMkDependHS diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs index b16a95a..01e7bb2 100644 --- a/ghc/compiler/main/MkIface.lhs +++ b/ghc/compiler/main/MkIface.lhs @@ -24,7 +24,7 @@ import HscTypes ( VersionInfo(..), IfaceDecls(..), ModIface(..), ModDetails(..) TyThing(..), DFunId, TypeEnv, isTyClThing, Avails, WhatsImported(..), GenAvailInfo(..), ImportVersion, AvailInfo, Deprecations(..), - Finder, ModuleLocation(..) + ModuleLocation(..) ) import CmdLineOpts @@ -56,6 +56,7 @@ import Type ( splitSigmaTy, tidyTopType, deNoteType ) import SrcLoc ( noSrcLoc ) import Outputable import Module ( ModuleName, moduleName ) +import Finder ( findModule ) import List ( partition ) import IO ( IOMode(..), openFile, hClose ) @@ -604,12 +605,12 @@ diffDecls old_vers old_fixities new_fixities old new %************************************************************************ \begin{code} -writeIface :: Finder -> Maybe ModIface -> IO () -writeIface finder Nothing +writeIface :: Maybe ModIface -> IO () +writeIface Nothing = return () -writeIface finder (Just mod_iface) - = do { maybe_found <- finder mod_name ; +writeIface (Just mod_iface) + = do { maybe_found <- findModule mod_name ; ; case maybe_found of { Nothing -> printErrs (text "Can't write interface file for" <+> ppr mod_name) ; Just (_, locn) -> diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 59039e99..65f980d 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -58,7 +58,7 @@ import UniqFM ( lookupUFM ) import Maybes ( maybeToBool, catMaybes ) import Outputable import IO ( openFile, IOMode(..) ) -import HscTypes ( Finder, PersistentCompilerState, HomeIfaceTable, HomeSymbolTable, +import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable, ModIface(..), WhatsImported(..), VersionInfo(..), ImportVersion, IfaceDecls(..), GlobalRdrEnv, AvailEnv, Avails, GenAvailInfo(..), AvailInfo, @@ -77,18 +77,18 @@ import List ( partition, nub ) %********************************************************* \begin{code} -renameModule :: DynFlags -> Finder +renameModule :: DynFlags -> HomeIfaceTable -> HomeSymbolTable -> PersistentCompilerState -> Module -> RdrNameHsModule -> IO (PersistentCompilerState, Maybe (ModIface, [RenamedHsDecl])) -- Nothing => some error occurred in the renamer -renameModule dflags finder hit hst old_pcs this_module rdr_module +renameModule dflags hit hst old_pcs this_module rdr_module = -- Initialise the renamer monad do { (new_pcs, errors_found, maybe_rn_stuff) - <- initRn dflags finder hit hst old_pcs this_module (rename this_module rdr_module) ; + <- initRn dflags hit hst old_pcs this_module (rename this_module rdr_module) ; -- Return results. No harm in updating the PCS if errors_found then @@ -351,7 +351,7 @@ rnDeprecs gbl_env Nothing decls %************************************************************************ \begin{code} -checkOldIface :: DynFlags -> Finder +checkOldIface :: DynFlags -> HomeIfaceTable -> HomeSymbolTable -> PersistentCompilerState -> Module @@ -360,8 +360,8 @@ checkOldIface :: DynFlags -> Finder -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface)) -- True <=> errors happened -checkOldIface dflags finder hit hst pcs mod source_unchanged maybe_iface - = initRn dflags finder hit hst pcs mod $ +checkOldIface dflags hit hst pcs mod source_unchanged maybe_iface + = initRn dflags hit hst pcs mod $ -- Load the old interface file, if we havn't already got it loadOldIface mod maybe_iface `thenRn` \ maybe_iface -> @@ -477,15 +477,15 @@ Suppose we discover we don't need to recompile. Then we start from the IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need. \begin{code} -closeIfaceDecls :: DynFlags -> Finder +closeIfaceDecls :: DynFlags -> HomeIfaceTable -> HomeSymbolTable -> PersistentCompilerState -> ModIface -- Get the decls from here -> IO (PersistentCompilerState, Bool, [RenamedHsDecl]) -- True <=> errors happened -closeIfaceDecls dflags finder hit hst pcs +closeIfaceDecls dflags hit hst pcs mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls }) - = initRn dflags finder hit hst pcs mod $ + = initRn dflags hit hst pcs mod $ let rule_decls = dcl_rules iface_decls diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index fb26ab7..9a13669 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -49,6 +49,7 @@ import Maybes ( maybeToBool, orElse ) import StringBuffer ( hGetStringBuffer ) import FastString ( mkFastString ) import ErrUtils ( Message ) +import Finder ( findModule ) import Lex import FiniteMap import Outputable @@ -487,9 +488,7 @@ findAndReadIface :: SDoc -> ModuleName findAndReadIface doc_str mod_name hi_boot_file = traceRn trace_msg `thenRn_` - - getFinderRn `thenRn` \ finder -> - ioToRnM (finder mod_name) `thenRn` \ maybe_found -> + ioToRnM (findModule mod_name) `thenRn` \ maybe_found -> case maybe_found of Right (Just (mod,locn)) diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index ed01e18..bb8c295 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -35,8 +35,7 @@ import IOExts ( IORef, newIORef, readIORef, writeIORef, unsafePerformIO ) import HsSyn import RdrHsSyn import RnHsSyn ( RenamedFixitySig ) -import HscTypes ( Finder, - AvailEnv, lookupTypeEnv, +import HscTypes ( AvailEnv, lookupTypeEnv, OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv, WhetherHasOrphans, ImportVersion, PersistentRenamerState(..), IsBootInterface, Avails, @@ -120,7 +119,6 @@ data RnDown rn_mod :: Module, -- This module rn_loc :: SrcLoc, -- Current locn - rn_finder :: Finder, rn_dflags :: DynFlags, rn_hit :: HomeIfaceTable, @@ -286,7 +284,7 @@ type IsLoaded = Bool %************************************************************************ \begin{code} -initRn :: DynFlags -> Finder +initRn :: DynFlags -> HomeIfaceTable -> HomeSymbolTable -> PersistentCompilerState -> Module @@ -294,7 +292,7 @@ initRn :: DynFlags -> Finder -> IO (PersistentCompilerState, Bool, t) -- True <=> found errors -initRn dflags finder hit hst pcs mod do_rn +initRn dflags hit hst pcs mod do_rn = do let prs = pcs_PRS pcs let pst = pcs_PST pcs @@ -319,7 +317,6 @@ initRn dflags finder hit hst pcs mod do_rn let rn_down = RnDown { rn_mod = mod, rn_loc = noSrcLoc, - rn_finder = finder, rn_dflags = dflags, rn_hit = hit, rn_done = is_done hst pst, @@ -399,7 +396,7 @@ renameSourceCode dflags mod prs m rn_errs = errs_var, rn_mod = mod, rn_done = bogus "rn_done", rn_hit = bogus "rn_hit", - rn_ifaces = bogus "rn_ifaces", rn_finder = bogus "rn_finder" + rn_ifaces = bogus "rn_ifaces" } s_down = SDown { rn_mode = InterfaceMode, -- So that we can refer to PrelBase.True etc @@ -576,9 +573,6 @@ getSrcLocRn down l_down %===================== \begin{code} -getFinderRn :: RnM d Finder -getFinderRn down l_down = return (rn_finder down) - getHomeIfaceTableRn :: RnM d HomeIfaceTable getHomeIfaceTableRn down l_down = return (rn_hit down)