[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.

ghc/compiler/Makefile

 # -----------------------------------------------------------------------------
-# $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

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

ghc/compiler/main/DriverFlags.hs

 -----------------------------------------------------------------------------
--- $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

ghc/compiler/main/DriverPipeline.hs

 -----------------------------------------------------------------------------
--- $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);

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)

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)

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,

ghc/compiler/main/Main.hs

 {-# 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
 

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) ->

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

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))

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)