From 4631557d51ec5573faa28c2062a861e630ab4993 Mon Sep 17 00:00:00 2001 From: sewardj Date: Wed, 15 Nov 2000 10:49:54 +0000 Subject: [PATCH] [project @ 2000-11-15 10:49:53 by sewardj] Fix up the Batch vs Interactive plumbing. --- ghc/compiler/basicTypes/BasicTypes.lhs | 15 +------- ghc/compiler/compMan/CmLink.lhs | 3 +- ghc/compiler/compMan/CmStaticInfo.lhs | 4 ++- ghc/compiler/compMan/CompManager.lhs | 59 +++++++++++++++++--------------- ghc/compiler/main/Main.hs | 9 ++--- 5 files changed, 41 insertions(+), 49 deletions(-) diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs index 7551596..820a3b9 100644 --- a/ghc/compiler/basicTypes/BasicTypes.lhs +++ b/ghc/compiler/basicTypes/BasicTypes.lhs @@ -36,9 +36,7 @@ module BasicTypes( InsideLam, insideLam, notInsideLam, OneBranch, oneBranch, notOneBranch, - EP(..), - - GhciMode(..) + EP(..) ) where #include "HsVersions.h" @@ -204,17 +202,6 @@ isNonRec NonRecursive = True %************************************************************************ %* * -\subsection[Interactive/Batch]{Interactive/Batch flag} -%* * -%************************************************************************ - -\begin{code} -data GhciMode = Batch - | Interactive -\end{code} - -%************************************************************************ -%* * \subsection[Generic]{Generic flag} %* * %************************************************************************ diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs index 12b1f7f..dfb84e9 100644 --- a/ghc/compiler/compMan/CmLink.lhs +++ b/ghc/compiler/compMan/CmLink.lhs @@ -14,13 +14,12 @@ where import Interpreter -import CmStaticInfo ( PackageConfigInfo ) +import CmStaticInfo ( PackageConfigInfo, GhciMode(..) ) import Module ( ModuleName, PackageName ) import Outputable ( SDoc ) import Digraph ( SCC(..), flattenSCC, flattenSCCs ) import Outputable import Panic ( panic ) -import BasicTypes ( GhciMode(..) ) #include "HsVersions.h" \end{code} diff --git a/ghc/compiler/compMan/CmStaticInfo.lhs b/ghc/compiler/compMan/CmStaticInfo.lhs index 2df34ec..5420bfc 100644 --- a/ghc/compiler/compMan/CmStaticInfo.lhs +++ b/ghc/compiler/compMan/CmStaticInfo.lhs @@ -4,7 +4,7 @@ \section[CmStaticInfo]{Session-static info for the Compilation Manager} \begin{code} -module CmStaticInfo ( Package(..), PackageConfigInfo ) +module CmStaticInfo ( GhciMode(..), Package(..), PackageConfigInfo ) where #include "HsVersions.h" @@ -12,6 +12,8 @@ where \end{code} \begin{code} +data GhciMode = Batch | Interactive + type PackageConfigInfo = [Package] -- copied from the driver diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index c9ba801..5f5505c 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -27,10 +27,10 @@ import CmLink ( PersistentLinkerState, emptyPLS, Linkable(..), import Interpreter ( HValue ) import CmSummarise ( summarise, ModSummary(..), name_of_summary, deps_of_summary, - mimp_name, ms_get_imports, is_source_import ) + mimp_name, ms_get_imports {-, is_source_import-} ) import Module ( ModuleName, moduleName, packageOfModule, isModuleInThisPackage, PackageName, moduleEnvElts ) -import CmStaticInfo ( Package(..), PackageConfigInfo ) +import CmStaticInfo ( Package(..), PackageConfigInfo, GhciMode ) import DriverPipeline ( compile, preprocess, doLink, CompResult(..) ) import HscTypes ( HomeSymbolTable, HomeIfaceTable, PersistentCompilerState, ModDetails(..) ) @@ -38,7 +38,6 @@ import Name ( lookupNameEnv ) import PrelNames ( mainName ) import HscMain ( initPersistentCompilerState ) import Finder ( findModule, emptyHomeDirCache ) -import BasicTypes ( GhciMode(..) ) import DriverUtil ( BarfKind(..) ) import Exception ( throwDyn ) \end{code} @@ -46,9 +45,9 @@ import Exception ( throwDyn ) \begin{code} -cmInit :: PackageConfigInfo -> IO CmState -cmInit raw_package_info - = emptyCmState raw_package_info +cmInit :: PackageConfigInfo -> GhciMode -> IO CmState +cmInit raw_package_info gmode + = emptyCmState raw_package_info gmode cmGetExpr :: CmState -> ModuleName @@ -65,17 +64,19 @@ cmRunExpr hval -- Persistent state just for CM, excluding link & compile subsystems data PersistentCMState = PersistentCMState { - hst :: HomeSymbolTable, -- home symbol table - hit :: HomeIfaceTable, -- home interface table - ui :: UnlinkedImage, -- the unlinked images - mg :: ModuleGraph, -- the module graph - pci :: PackageConfigInfo -- NEVER CHANGES + hst :: HomeSymbolTable, -- home symbol table + hit :: HomeIfaceTable, -- home interface table + ui :: UnlinkedImage, -- the unlinked images + mg :: ModuleGraph, -- the module graph + pci :: PackageConfigInfo, -- NEVER CHANGES + gmode :: GhciMode -- NEVER CHANGES } -emptyPCMS :: PackageConfigInfo -> PersistentCMState -emptyPCMS pci +emptyPCMS :: PackageConfigInfo -> GhciMode -> PersistentCMState +emptyPCMS pci gmode = PersistentCMState { hst = emptyHST, hit = emptyHIT, - ui = emptyUI, mg = emptyMG, pci = pci } + ui = emptyUI, mg = emptyMG, + pci = pci, gmode = gmode } emptyHIT :: HomeIfaceTable emptyHIT = emptyUFM @@ -92,9 +93,9 @@ data CmState pls :: PersistentLinkerState -- link's persistent state } -emptyCmState :: PackageConfigInfo -> IO CmState -emptyCmState pci - = do let pcms = emptyPCMS pci +emptyCmState :: PackageConfigInfo -> GhciMode -> IO CmState +emptyCmState pci gmode + = do let pcms = emptyPCMS pci gmode pcs <- initPersistentCompilerState pls <- emptyPLS return (CmState { pcms = pcms, @@ -123,15 +124,16 @@ cmLoadModule :: CmState cmLoadModule cmstate1 modname = do -- version 1's are the original, before downsweep - let pcms1 = pcms cmstate1 - let pls1 = pls cmstate1 - let pcs1 = pcs cmstate1 - let mg1 = mg pcms1 - let hst1 = hst pcms1 - let hit1 = hit pcms1 - let ui1 = ui pcms1 + let pcms1 = pcms cmstate1 + let pls1 = pls cmstate1 + let pcs1 = pcs cmstate1 + let mg1 = mg pcms1 + let hst1 = hst pcms1 + let hit1 = hit pcms1 + let ui1 = ui pcms1 - let pcii = pci pcms1 -- this never changes + let pcii = pci pcms1 -- this never changes + let ghci_mode = gmode pcms1 -- ToDo: fix! -- do the downsweep to reestablish the module graph -- then generate version 2's by removing from HIT,HST,UI any @@ -168,7 +170,6 @@ cmLoadModule cmstate1 modname -- Try and do linking in some form, depending on whether the -- upsweep was completely or only partially successful. - let ghci_mode = Batch -- ToDo: fix! if upsweepOK @@ -191,7 +192,8 @@ cmLoadModule cmstate1 modname -> panic "cmLoadModule: link failed (1)" LinkOK pls3 -> do let pcms3 = PersistentCMState { hst=hst3, hit=hit3, - ui=ui3, mg=mg2, pci=pcii } + ui=ui3, mg=mg2, + pci=pcii, gmode=ghci_mode } let cmstate3 = CmState { pcms=pcms3, pcs=pcs3, pls=pls3 } return (cmstate3, Just modname) @@ -213,7 +215,8 @@ cmLoadModule cmstate1 modname -> panic "cmLoadModule: link failed (2)" LinkOK pls4 -> do let pcms4 = PersistentCMState { hst=hst4, hit=hit4, - ui=ui4, mg=mg2, pci=pcii } + ui=ui4, mg=mg2, + pci=pcii, gmode=ghci_mode } let cmstate4 = CmState { pcms=pcms4, pcs=pcs3, pls=pls4 } return (cmstate4, Just modname) diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index dbbb12f..109af75 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.21 2000/11/14 16:28:38 simonmar Exp $ +-- $Id: Main.hs,v 1.22 2000/11/15 10:49:54 sewardj Exp $ -- -- GHC Driver program -- @@ -21,6 +21,7 @@ import DriverState import DriverFlags import DriverMkDepend import DriverUtil +import Panic import DriverPhases ( Phase(..) ) import CmdLineOpts ( HscLang(..), DynFlags(..), v_Static_hsc_opts ) import Module ( mkModuleName ) @@ -29,7 +30,6 @@ import Finder ( initFinder ) import CmStaticInfo import Config import Util -import Panic import Concurrent #ifndef mingw32_TARGET_OS @@ -198,6 +198,7 @@ main = stgToDo = stg_todo, hscLang = lang, -- leave out hscOutName for now + hscOutName = panic "Main.main:hscOutName not set", flags = [] } -- the rest of the arguments are "dynamic" @@ -274,7 +275,7 @@ beginMake :: PackageConfigInfo -> [String] -> IO () beginMake pkg_details mods = do case mods of [] -> throwDyn (UsageError "no input files") - [mod] -> do state <- cmInit pkg_details + [mod] -> do state <- cmInit pkg_details Batch cmLoadModule state (mkModuleName mod) return () _ -> throwDyn (UsageError "only one module allowed with --make") @@ -282,7 +283,7 @@ beginMake pkg_details mods beginInteractive pkg_details mods = do case mods of [] -> return () - [mod] -> do state <- cmInit pkg_details + [mod] -> do state <- cmInit pkg_details Interactive cmLoadModule state (mkModuleName mod) return () _ -> throwDyn (UsageError -- 1.7.10.4