Commit fd99cf4f authored by sewardj's avatar sewardj
Browse files

[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.
parent 212cb7d1
# -----------------------------------------------------------------------------
# $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
......
......@@ -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
......
-----------------------------------------------------------------------------
-- $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
......
-----------------------------------------------------------------------------
-- $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);
......
......@@ -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)
......
......@@ -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)
......
......@@ -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,
......
{-# 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
......
......@@ -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) ->
......
......@@ -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
......
......@@ -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))
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment