-initPersistentCompilerState :: IO PersistentCompilerState
-initPersistentCompilerState
- = do prs <- initPersistentRenamerState
- return (
- PCS { pcs_PIT = emptyIfaceTable,
- pcs_PTE = wiredInThingEnv,
- pcs_insts = emptyInstEnv,
- pcs_rules = emptyRuleBase,
- pcs_PRS = prs
- }
- )
-
-initPersistentRenamerState :: IO PersistentRenamerState
- = do us <- mkSplitUniqSupply 'r'
- return (
- PRS { prsOrig = NameSupply { nsUniqs = us,
- nsNames = initOrigNames,
- nsIPs = emptyFM },
- prsDecls = (emptyNameEnv, 0),
- prsInsts = (emptyBag, 0),
- prsRules = (emptyBag, 0),
- prsImpMods = emptyFM
- }
- )
-
-initOrigNames :: FiniteMap (ModuleName,OccName) Name
-initOrigNames
- = grab knownKeyNames `plusFM` grab (map getName wiredInThings)
- where
- grab names = foldl add emptyFM names
- add env name
- = addToFM env (moduleName (nameModule name), nameOccName name) name
-
-
-initRules :: PackageRuleBase
-initRules = emptyRuleBase
-{- SHOULD BE (ish)
- foldl add emptyVarEnv builtinRules
- where
- add env (name,rule)
- = extendRuleBase env name rule
--}
+#ifdef GHCI
+type GetInfoResult = (String, (IfaceDecl, Fixity, SrcLoc, [(IfaceInst,SrcLoc)]))
+
+hscGetInfo -- like hscStmt, but deals with a single identifier
+ :: HscEnv
+ -> InteractiveContext -- Context for compiling
+ -> String -- The identifier
+ -> IO [GetInfoResult]
+
+hscGetInfo hsc_env ic str
+ = do maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
+ case maybe_rdr_name of {
+ Nothing -> return [];
+ Just (L _ rdr_name) -> do
+
+ maybe_tc_result <- tcRnGetInfo hsc_env ic rdr_name
+
+ let -- str' is the the naked occurrence name
+ -- after stripping off qualification and parens (+)
+ str' = occNameUserString (rdrNameOcc rdr_name)
+
+ case maybe_tc_result of {
+ Nothing -> return [] ;
+ Just things -> return [(str', t) | t <- things]
+ }}
+#endif
+\end{code}
+
+%************************************************************************
+%* *
+ Desugar, simplify, convert to bytecode, and link an expression
+%* *
+%************************************************************************
+
+\begin{code}
+#ifdef GHCI
+compileExpr :: HscEnv
+ -> Module -> GlobalRdrEnv -> TypeEnv
+ -> LHsExpr Id
+ -> IO HValue
+
+compileExpr hsc_env this_mod rdr_env type_env tc_expr
+ = do { let { dflags = hsc_dflags hsc_env ;
+ lint_on = dopt Opt_DoCoreLinting dflags }
+
+ -- Desugar it
+ ; ds_expr <- deSugarExpr hsc_env this_mod rdr_env type_env tc_expr
+
+ -- Flatten it
+ ; flat_expr <- flattenExpr hsc_env ds_expr
+
+ -- Simplify it
+ ; simpl_expr <- simplifyExpr dflags flat_expr
+
+ -- Tidy it (temporary, until coreSat does cloning)
+ ; tidy_expr <- tidyCoreExpr simpl_expr
+
+ -- Prepare for codegen
+ ; prepd_expr <- corePrepExpr dflags tidy_expr
+
+ -- Lint if necessary
+ -- ToDo: improve SrcLoc
+ ; if lint_on then
+ case lintUnfolding noSrcLoc [] prepd_expr of
+ Just err -> pprPanic "compileExpr" err
+ Nothing -> return ()
+ else
+ return ()
+
+ -- Convert to BCOs
+ ; bcos <- coreExprToBCOs dflags prepd_expr
+
+ -- link it
+ ; hval <- linkExpr hsc_env bcos
+
+ ; return hval
+ }
+#endif
+\end{code}
+
+
+%************************************************************************
+%* *
+ Statistics on reading interfaces
+%* *
+%************************************************************************
+
+\begin{code}
+dumpIfaceStats :: HscEnv -> IO ()
+dumpIfaceStats hsc_env
+ = do { eps <- readIORef (hsc_EPS hsc_env)
+ ; dumpIfSet (dump_if_trace || dump_rn_stats)
+ "Interface statistics"
+ (ifaceStats eps) }
+ where
+ dflags = hsc_dflags hsc_env
+ dump_rn_stats = dopt Opt_D_dump_rn_stats dflags
+ dump_if_trace = dopt Opt_D_dump_if_trace dflags