From 0ef29fb878dd6517d2716afb056bcf2536c2562e Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 18 Jan 2001 12:54:17 +0000 Subject: [PATCH 1/1] [project @ 2001-01-18 12:54:16 by simonmar] Make the GHCi command line behave as if an "import qualified M" was in force for all M. The renamer now has a new "mode": CmdLineMode, which changes the lookup machinery to turn a qualified lookup into an original name lookup if the qualified name isn't otherwise in scope. --- ghc/compiler/ghci/InteractiveUI.hs | 5 ++-- ghc/compiler/main/HscMain.lhs | 2 +- ghc/compiler/rename/Rename.lhs | 2 +- ghc/compiler/rename/RnEnv.lhs | 52 ++++++++++++++++++++++++------------ ghc/compiler/rename/RnExpr.lhs | 24 ++++++++--------- ghc/compiler/rename/RnMonad.lhs | 8 ++++-- 6 files changed, 58 insertions(+), 35 deletions(-) diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs index c3c163a..cf301f4 100644 --- a/ghc/compiler/ghci/InteractiveUI.hs +++ b/ghc/compiler/ghci/InteractiveUI.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: InteractiveUI.hs,v 1.27 2001/01/18 10:51:53 simonmar Exp $ +-- $Id: InteractiveUI.hs,v 1.28 2001/01/18 12:54:16 simonmar Exp $ -- -- GHC Interactive User Interface -- @@ -167,7 +167,8 @@ doCommand expr = do expr_expanded <- expandExpr expr -- io (putStrLn ( "Before: " ++ expr ++ "\nAfter: " ++ expr_expanded)) expr_ok <- timeIt (do ok <- evalExpr expr_expanded - when ok (evalExpr "PrelIO.putChar \'\\n\'" >> return ()) + when ok (evalExpr "PrelHandle.hFlush PrelHandle.stdout" >> return ()) + when ok (evalExpr "PrelHandle.hFlush PrelHandle.stderr" >> return ()) return ok) when expr_ok (rememberExpr expr_expanded) return False diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index a1269c4..377e2e5 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -433,7 +433,7 @@ hscExpr dflags hst hit pcs0 this_module expr wrap_print if (wrap_print && not is_IO_type) then do (new_pcs, maybe_stuff) <- hscExpr dflags hst hit pcs2 this_module - ("putStr (show (" ++ expr ++ "))") False + ("PrelIO.print (" ++ expr ++ ")") False case maybe_stuff of Nothing -> return (new_pcs, maybe_stuff) Just (bcos, _, _) -> diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 7a3ae9a..af9ccc6 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -126,7 +126,7 @@ renameExpr dflags hit hst pcs this_module expr print_unqual = unQualInScope rdr_env in - initRnMS rdr_env emptyLocalFixityEnv SourceMode (rnExpr expr) + initRnMS rdr_env emptyLocalFixityEnv CmdLineMode (rnExpr expr) `thenRn` \ (e,fvs) -> checkErrsRn `thenRn` \ no_errs_so_far -> diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 45f2184..b835791 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -18,7 +18,7 @@ import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv, ImportReason(..), GlobalRdrEnv, AvailEnv, AvailInfo, Avails, GenAvailInfo(..), NameSupply(..) ) import RnMonad -import Name ( Name, NamedThing(..), +import Name ( Name, getSrcLoc, mkLocalName, mkGlobalName, mkIPName, nameOccName, nameModule_maybe, @@ -177,13 +177,12 @@ lookupBndrRn rdr_name lookupTopBndrRn rdr_name = getModeRn `thenRn` \ mode -> - case mode of - InterfaceMode -> lookupIfaceName rdr_name - - SourceMode -> -- Source mode, so look up a *qualified* version - -- of the name, so that we get the right one even - -- if there are many with the same occ name - -- There must *be* a binding + if isInterfaceMode mode + then lookupIfaceName rdr_name + else -- Source mode, so look up a *qualified* version + -- of the name, so that we get the right one even + -- if there are many with the same occ name + -- There must *be* a binding getModuleRn `thenRn` \ mod -> getGlobalNameEnv `thenRn` \ global_env -> lookupSrcName global_env (qualifyRdrName (moduleName mod) rdr_name) @@ -216,11 +215,32 @@ lookupOccRn rdr_name lookupGlobalOccRn rdr_name = getModeRn `thenRn` \ mode -> + if (isInterfaceMode mode) + then lookupIfaceName rdr_name + else + + getGlobalNameEnv `thenRn` \ global_env -> case mode of - SourceMode -> getGlobalNameEnv `thenRn` \ global_env -> - lookupSrcName global_env rdr_name + SourceMode -> lookupSrcName global_env rdr_name + + CmdLineMode + | not (isQual rdr_name) -> + lookupSrcName global_env rdr_name + + -- We allow qualified names on the command line to refer to + -- *any* name exported by any module in scope, just as if + -- there was an "import qualified M" declaration for every + -- module. + -- + -- First look up the name in the normal environment. If + -- it isn't there, we manufacture a new occurrence of an + -- original name. + | otherwise -> + case lookupRdrEnv global_env rdr_name of + Just _ -> lookupSrcName global_env rdr_name + Nothing -> newGlobalName (rdrNameModule rdr_name) + (rdrNameOcc rdr_name) - InterfaceMode -> lookupIfaceName rdr_name lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad @@ -270,7 +290,6 @@ calls it at all I think). \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}} - \begin{code} lookupOrigNames :: [RdrName] -> RnM d NameSet lookupOrigNames rdr_names @@ -278,10 +297,10 @@ lookupOrigNames rdr_names returnRn (mkNameSet names) \end{code} -lookupSysBinder is used for the "system binders" of a type, class, or instance decl. -It ensures that the module is set correctly in the name cache, and sets the provenance -on the returned name too. The returned name will end up actually in the type, class, -or instance. +lookupSysBinder is used for the "system binders" of a type, class, or +instance decl. It ensures that the module is set correctly in the +name cache, and sets the provenance on the returned name too. The +returned name will end up actually in the type, class, or instance. \begin{code} lookupSysBinder rdr_name @@ -292,7 +311,6 @@ lookupSysBinder rdr_name \end{code} - %********************************************************* %* * \subsection{Binding} diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs index 40e3f9e..6270233 100644 --- a/ghc/compiler/rename/RnExpr.lhs +++ b/ghc/compiler/rename/RnExpr.lhs @@ -121,10 +121,10 @@ rnPat (ConOpPatIn pat1 con _ pat2) getModeRn `thenRn` \ mode -> -- See comments with rnExpr (OpApp ...) - (case mode of - InterfaceMode -> returnRn (ConOpPatIn pat1' con' defaultFixity pat2') - SourceMode -> lookupFixityRn con' `thenRn` \ fixity -> - mkConOpPatRn pat1' con' fixity pat2' + (if isInterfaceMode mode + then returnRn (ConOpPatIn pat1' con' defaultFixity pat2') + else lookupFixityRn con' `thenRn` \ fixity -> + mkConOpPatRn pat1' con' fixity pat2' ) `thenRn` \ pat' -> returnRn (pat', fvs1 `plusFV` fvs2 `addOneFV` con') @@ -313,10 +313,10 @@ rnExpr (OpApp e1 op _ e2) -- that the deriving code generator got the association correct -- Don't even look up the fixity when in interface mode getModeRn `thenRn` \ mode -> - (case mode of - SourceMode -> lookupFixityRn op_name `thenRn` \ fixity -> - mkOpAppRn e1' op' fixity e2' - InterfaceMode -> returnRn (OpApp e1' op' defaultFixity e2') + (if isInterfaceMode mode + then returnRn (OpApp e1' op' defaultFixity e2') + else lookupFixityRn op_name `thenRn` \ fixity -> + mkOpAppRn e1' op' fixity e2' ) `thenRn` \ final_e -> returnRn (final_e, @@ -734,10 +734,10 @@ checkPrecMatch True op (Match _ (p1:p2:_) _ _) -- True indicates an infix lhs = getModeRn `thenRn` \ mode -> -- See comments with rnExpr (OpApp ...) - case mode of - InterfaceMode -> returnRn () - SourceMode -> checkPrec op p1 False `thenRn_` - checkPrec op p2 True + if isInterfaceMode mode + then returnRn () + else checkPrec op p1 False `thenRn_` + checkPrec op p2 True checkPrecMatch True op _ = panic "checkPrecMatch" diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index 2a795e5..5a215ab 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -166,8 +166,12 @@ data SDown = SDown { -- with RnIfaces.lookupLocalFixity } -data RnMode = SourceMode -- Renaming source code - | InterfaceMode -- Renaming interface declarations. +data RnMode = SourceMode -- Renaming source code + | InterfaceMode -- Renaming interface declarations. + | CmdLineMode -- Renaming a command-line expression + +isInterfaceMode InterfaceMode = True +isInterfaceMode _ = False \end{code} %=================================================== -- 1.7.10.4