[project @ 2000-10-13 10:26:38 by sewardj]

[ghc-hetmet.git] / ghc / compiler / main / HscMain.lhs

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index aeb12b2..9259a52 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -49,6 +49,13 @@ import NativeInfo       ( os, arch )
 import StgInterp       ( runStgI )
 \end{code}
 
+
+%************************************************************************
+%*                                                                     *
+\subsection{The main compiler pipeline}
+%*                                                                     *
+%************************************************************************
+
 \begin{code}
 hscMain
   :: DynFlags  
@@ -91,8 +98,6 @@ hscMain flags core_cmds stg_cmds summary maybe_old_iface
        (ppSourceStats False rdr_module)                >>
 
     -- UniqueSupplies for later use (these are the only lower case uniques)
-    mkSplitUniqSupply 'r'      >>= \ rn_uniqs  -> -- renamer
-    mkSplitUniqSupply 'a'      >>= \ tc_uniqs  -> -- typechecker
     mkSplitUniqSupply 'd'      >>= \ ds_uniqs  -> -- desugarer
     mkSplitUniqSupply 'r'      >>= \ ru_uniqs  -> -- rules
     mkSplitUniqSupply 'c'      >>= \ c2s_uniqs -> -- core-to-stg
@@ -224,7 +229,48 @@ hscMain flags core_cmds stg_cmds summary maybe_old_iface
       = if opt_D_show_passes
        then \ what -> hPutStr stderr ("*** "++what++":\n")
        else \ what -> return ()
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
+\subsection{Initial persistent state}
+%*                                                                     *
+%************************************************************************
 
+\begin{code}
+initPersistentCompilerState :: PersistentCompilerState
+initPersistentCompilerState 
+  = PCS { pcsPST   = initPackageDetails,
+         pcsInsts = emptyInstEnv,
+         pcsRules = emptyRuleEnv,
+         pcsPRS   = initPersistentRenamerState }
+
+initPackageDetails :: PackageSymbolTable
+initPackageDetails = extendTypeEnv emptyModuleEnv wiredInThings
+
+initPersistentRenamerState :: PersistentRenamerState
+  = PRS { prsOrig  = Orig { origNames  = initOrigNames,
+                           origIParam = emptyFM },
+         prsDecls = emptyNameEnv,
+         prsInsts = emptyBag,
+         prsRules = emptyBag
+    }
+
+initOrigNames :: FiniteMap (ModuleName,OccName) Name
+initOrigNames = grab knownKeyNames `plusFM` grab wiredInNames
+             where
+               grab names   = foldl add emptyFM names
+               add env name = addToFM env (moduleName (nameModule name), nameOccName name) name
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{Statistics}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
 ppSourceStats short (HsModule name version exports imports decls _ src_loc)
  = (if short then hcat else vcat)
         (map pp_val