summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ghc/compiler/ghci/InteractiveUI.hs5
-rw-r--r--ghc/compiler/main/HscMain.lhs2
-rw-r--r--ghc/compiler/rename/Rename.lhs2
-rw-r--r--ghc/compiler/rename/RnEnv.lhs52
-rw-r--r--ghc/compiler/rename/RnExpr.lhs24
-rw-r--r--ghc/compiler/rename/RnMonad.lhs8
6 files changed, 58 insertions, 35 deletions
diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index c3c163aab1..cf301f47fb 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 a1269c4c67..377e2e5970 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 7a3ae9a3d1..af9ccc6e11 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 45f2184b31..b835791154 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 40e3f9ed1b..6270233479 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 2a795e5484..5a215abfe9 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}
%===================================================
View Lorry Controller Status