summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2012-04-13 10:37:48 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2012-04-13 10:37:48 +0100
commite0e99f9948c1eac82cf69dd3cc30cb068e42d45e (patch)
tree1e41f64f5d84e884288b7f49745d7e5ea77c7798
parenteecd7c98c1f079c14d99ed831dff33a48ee45e67 (diff)
downloadhaskell-e0e99f9948c1eac82cf69dd3cc30cb068e42d45e.tar.gz
Revert "Added ':runmonad' command to GHCi"
Two problems, for now at any rate a) Breaks the build with lots of errors like No instance for (Show (IO ())) arising from a use of `print' b) Discussion of the approache hasn't converged yet (Simon M had a number of suggestions) This reverts commit eecd7c98c1f079c14d99ed831dff33a48ee45e67.
-rw-r--r--compiler/hsSyn/HsTypes.lhs191
-rw-r--r--compiler/main/GHC.hs13
-rw-r--r--compiler/main/HscMain.hs6
-rw-r--r--compiler/main/HscTypes.lhs7
-rw-r--r--compiler/prelude/PrelNames.lhs34
-rw-r--r--compiler/typecheck/TcExpr.lhs2
-rw-r--r--compiler/typecheck/TcRnDriver.lhs61
-rw-r--r--compiler/typecheck/TcRnMonad.lhs3
-rw-r--r--ghc/InteractiveUI.hs9
9 files changed, 119 insertions, 207 deletions
diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index b41070b3bc..9e8d27bde0 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -6,33 +6,41 @@
HsTypes: Abstract syntax: user-defined types
\begin{code}
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
{-# LANGUAGE DeriveDataTypeable #-}
+
module HsTypes (
- HsType(..), LHsType, HsKind, LHsKind,
- HsBndrSig(..), HsTyVarBndr(..), LHsTyVarBndr,
- HsTupleSort(..), HsExplicitFlag(..),
- HsContext, LHsContext,
- HsQuasiQuote(..),
+ HsType(..), LHsType, HsKind, LHsKind,
+ HsBndrSig(..), HsTyVarBndr(..), LHsTyVarBndr,
+ HsTupleSort(..), HsExplicitFlag(..),
+ HsContext, LHsContext,
+ HsQuasiQuote(..),
HsTyWrapper(..),
HsTyLit(..),
- LBangType, BangType, HsBang(..),
+ LBangType, BangType, HsBang(..),
getBangType, getBangStrictness,
- ConDeclField(..), pprConDeclFields,
-
- mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
- hsTyVarName, hsTyVarNames,
- hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
- splitHsInstDeclTy_maybe, splitLHsInstDeclTy_maybe,
+ ConDeclField(..), pprConDeclFields,
+
+ mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
+ hsTyVarName, hsTyVarNames,
+ hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
+ splitHsInstDeclTy_maybe, splitLHsInstDeclTy_maybe,
splitHsForAllTy, splitLHsForAllTy,
splitHsClassTy_maybe, splitLHsClassTy_maybe,
splitHsFunType,
- splitHsAppTys, mkHsAppTys, mkHsOpTy,
+ splitHsAppTys, mkHsAppTys, mkHsOpTy,
placeHolderBndrs,
- -- Printing
- pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context,
+ -- Printing
+ pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context,
) where
import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
@@ -54,16 +62,16 @@ import Data.Data
%************************************************************************
-%* *
- Quasi quotes; used in types and elsewhere
-%* *
+%* *
+ Quasi quotes; used in types and elsewhere
+%* *
%************************************************************************
\begin{code}
data HsQuasiQuote id = HsQuasiQuote
- id -- The quasi-quoter
- SrcSpan -- The span of the enclosed string
- FastString -- The enclosed string
+ id -- The quasi-quoter
+ SrcSpan -- The span of the enclosed string
+ FastString -- The enclosed string
deriving (Data, Typeable)
instance OutputableBndr id => Outputable (HsQuasiQuote id) where
@@ -77,14 +85,14 @@ ppr_qq (HsQuasiQuote quoter _ quote) =
%************************************************************************
-%* *
+%* *
\subsection{Bang annotations}
-%* *
+%* *
%************************************************************************
\begin{code}
type LBangType name = Located (BangType name)
-type BangType name = HsType name -- Bangs are in the HsType data type
+type BangType name = HsType name -- Bangs are in the HsType data type
getBangType :: LHsType a -> LHsType a
getBangType (L _ (HsBangTy _ ty)) = ty
@@ -97,9 +105,9 @@ getBangStrictness _ = HsNoBang
%************************************************************************
-%* *
+%* *
\subsection{Data types}
-%* *
+%* *
%************************************************************************
This is the syntax for types as seen in type signatures.
@@ -133,8 +141,8 @@ placeHolderBndrs :: [Name]
placeHolderBndrs = panic "placeHolderBndrs"
data HsTyVarBndr name
- = UserTyVar -- No explicit kinding
- name -- See Note [Printing KindedTyVars]
+ = UserTyVar -- No explicit kinding
+ name -- See Note [Printing KindedTyVars]
| KindedTyVar
name
@@ -145,57 +153,57 @@ data HsTyVarBndr name
deriving (Data, Typeable)
data HsType name
- = HsForAllTy HsExplicitFlag -- Renamer leaves this flag unchanged, to record the way
- -- the user wrote it originally, so that the printer can
- -- print it as the user wrote it
- [LHsTyVarBndr name] -- See Note [HsForAllTy tyvar binders]
- (LHsContext name)
- (LHsType name)
-
- | HsTyVar name -- Type variable, type constructor, or data constructor
+ = HsForAllTy HsExplicitFlag -- Renamer leaves this flag unchanged, to record the way
+ -- the user wrote it originally, so that the printer can
+ -- print it as the user wrote it
+ [LHsTyVarBndr name] -- See Note [HsForAllTy tyvar binders]
+ (LHsContext name)
+ (LHsType name)
+
+ | HsTyVar name -- Type variable, type constructor, or data constructor
-- see Note [Promotions (HsTyVar)]
- | HsAppTy (LHsType name)
- (LHsType name)
+ | HsAppTy (LHsType name)
+ (LHsType name)
- | HsFunTy (LHsType name) -- function type
- (LHsType name)
+ | HsFunTy (LHsType name) -- function type
+ (LHsType name)
- | HsListTy (LHsType name) -- Element type
+ | HsListTy (LHsType name) -- Element type
- | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
+ | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
- | HsTupleTy HsTupleSort
- [LHsType name] -- Element types (length gives arity)
+ | HsTupleTy HsTupleSort
+ [LHsType name] -- Element types (length gives arity)
- | HsOpTy (LHsType name) (LHsTyOp name) (LHsType name)
+ | HsOpTy (LHsType name) (LHsTyOp name) (LHsType name)
- | HsParTy (LHsType name) -- See Note [Parens in HsSyn] in HsExpr
- -- Parenthesis preserved for the precedence re-arrangement in RnTypes
- -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
+ | HsParTy (LHsType name) -- See Note [Parens in HsSyn] in HsExpr
+ -- Parenthesis preserved for the precedence re-arrangement in RnTypes
+ -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
- | HsIParamTy (IPName name) -- (?x :: ty)
+ | HsIParamTy (IPName name) -- (?x :: ty)
(LHsType name) -- Implicit parameters as they occur in contexts
| HsEqTy (LHsType name) -- ty1 ~ ty2
(LHsType name) -- Always allowed even without TypeOperators, and has special kinding rule
- | HsKindSig (LHsType name) -- (ty :: kind)
- (LHsKind name) -- A type with a kind signature
+ | HsKindSig (LHsType name) -- (ty :: kind)
+ (LHsKind name) -- A type with a kind signature
- | HsQuasiQuoteTy (HsQuasiQuote name)
+ | HsQuasiQuoteTy (HsQuasiQuote name)
- | HsSpliceTy (HsSplice name)
- FreeVars -- Variables free in the splice (filled in by renamer)
- PostTcKind
+ | HsSpliceTy (HsSplice name)
+ FreeVars -- Variables free in the splice (filled in by renamer)
+ PostTcKind
| HsDocTy (LHsType name) LHsDocString -- A documented type
- | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
- | HsRecTy [ConDeclField name] -- Only in data type declarations
+ | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
+ | HsRecTy [ConDeclField name] -- Only in data type declarations
- | HsCoreTy Type -- An escape hatch for tunnelling a *closed*
- -- Core Type through HsSyn.
+ | HsCoreTy Type -- An escape hatch for tunnelling a *closed*
+ -- Core Type through HsSyn.
| HsExplicitListTy -- A promoted explicit list
PostTcKind -- See Note [Promoted lists and tuples]
@@ -324,16 +332,16 @@ data HsTupleSort = HsUnboxedTuple
data HsExplicitFlag = Explicit | Implicit deriving (Data, Typeable)
-data ConDeclField name -- Record fields have Haddoc docs on them
+data ConDeclField name -- Record fields have Haddoc docs on them
= ConDeclField { cd_fld_name :: Located name,
- cd_fld_type :: LBangType name,
- cd_fld_doc :: Maybe LHsDocString }
+ cd_fld_type :: LBangType name,
+ cd_fld_doc :: Maybe LHsDocString }
deriving (Data, Typeable)
-----------------------
-- Combine adjacent for-alls.
-- The following awkward situation can happen otherwise:
--- f :: forall a. ((Num a) => Int)
+-- f :: forall a. ((Num a) => Int)
-- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
-- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
-- but the export list abstracts f wrt [a]. Disaster.
@@ -352,14 +360,14 @@ mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
-- mk_forall_ty makes a pure for-all type (no context)
mk_forall_ty :: HsExplicitFlag -> [LHsTyVarBndr name] -> LHsType name -> HsType name
-mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
+mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
-mk_forall_ty exp tvs ty = HsForAllTy exp tvs (noLoc []) ty
- -- Even if tvs is empty, we still make a HsForAll!
- -- In the Implicit case, this signals the place to do implicit quantification
- -- In the Explicit case, it prevents implicit quantification
- -- (see the sigtype production in Parser.y.pp)
- -- so that (forall. ty) isn't implicitly quantified
+mk_forall_ty exp tvs ty = HsForAllTy exp tvs (noLoc []) ty
+ -- Even if tvs is empty, we still make a HsForAll!
+ -- In the Implicit case, this signals the place to do implicit quantification
+ -- In the Explicit case, it prevents implicit quantification
+ -- (see the sigtype production in Parser.y.pp)
+ -- so that (forall. ty) isn't implicitly quantified
plus :: HsExplicitFlag -> HsExplicitFlag -> HsExplicitFlag
Implicit `plus` Implicit = Implicit
@@ -395,14 +403,14 @@ hsLTyVarLocNames = map hsLTyVarLocName
\begin{code}
splitHsAppTys :: LHsType n -> [LHsType n] -> (LHsType n, [LHsType n])
splitHsAppTys (L _ (HsAppTy f a)) as = splitHsAppTys f (a:as)
-splitHsAppTys f as = (f,as)
+splitHsAppTys f as = (f,as)
mkHsAppTys :: OutputableBndr n => LHsType n -> [LHsType n] -> HsType n
mkHsAppTys fun_ty [] = pprPanic "mkHsAppTys" (ppr fun_ty)
mkHsAppTys fun_ty (arg_ty:arg_tys)
= foldl mk_app (HsAppTy fun_ty arg_ty) arg_tys
where
- mk_app fun arg = HsAppTy (noLoc fun) arg
+ mk_app fun arg = HsAppTy (noLoc fun) arg
-- Add noLocs for inner nodes of the application;
-- they are never used
@@ -414,7 +422,7 @@ splitHsInstDeclTy_maybe ty
splitLHsInstDeclTy_maybe
:: LHsType name
-> Maybe ([LHsTyVarBndr name], HsContext name, Located name, [LHsType name])
- -- Split up an instance decl type, returning the pieces
+ -- Split up an instance decl type, returning the pieces
splitLHsInstDeclTy_maybe inst_ty = do
let (tvs, cxt, ty) = splitLHsForAllTy inst_ty
(cls, tys) <- splitLHsClassTy_maybe ty
@@ -456,20 +464,20 @@ splitLHsClassTy_maybe ty
-- Splits HsType into the (init, last) parts
-- Breaks up any parens in the result type:
--- splitHsFunType (a -> (b -> c)) = ([a,b], c)
+-- splitHsFunType (a -> (b -> c)) = ([a,b], c)
splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
where
(args, res) = splitHsFunType y
splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
-splitHsFunType other = ([], other)
+splitHsFunType other = ([], other)
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Pretty printing}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -492,12 +500,12 @@ pprHsForAll exp tvs cxt
| otherwise = pprHsContext (unLoc cxt)
where
show_forall = opt_PprStyle_Debug
- || (not (null tvs) && is_explicit)
+ || (not (null tvs) && is_explicit)
is_explicit = case exp of {Explicit -> True; Implicit -> False}
forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
-pprHsContext [] = empty
+pprHsContext [] = empty
pprHsContext [L _ pred] = ppr pred <+> darrow
pprHsContext cxt = ppr_hs_context cxt <+> darrow
@@ -509,8 +517,8 @@ pprConDeclFields :: OutputableBndr name => [ConDeclField name] -> SDoc
pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
where
ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
- cd_fld_doc = doc })
- = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
+ cd_fld_doc = doc })
+ = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
\end{code}
Note [Printing KindedTyVars]
@@ -534,12 +542,12 @@ pREC_OP = 2 -- Used for arg of any infix operator
pREC_CON = 3 -- Used for arg of type applicn:
-- always parenthesise unless atomic
-maybeParen :: Int -- Precedence of context
- -> Int -- Precedence of top-level operator
- -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
+maybeParen :: Int -- Precedence of context
+ -> Int -- Precedence of top-level operator
+ -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
- | otherwise = p
-
+ | otherwise = p
+
-- printing works more-or-less as for Types
pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
@@ -552,7 +560,7 @@ pprParendHsType ty = ppr_mono_ty pREC_CON ty
-- (b) Drop top-level for-all type variables in user style
-- since they are implicit in Haskell
prepare :: PprStyle -> HsType name -> HsType name
-prepare sty (HsParTy ty) = prepare sty (unLoc ty)
+prepare sty (HsParTy ty) = prepare sty (unLoc ty)
prepare _ ty = ty
ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
@@ -573,8 +581,8 @@ ppr_mono_ty _ (HsTupleTy con tys) = tupleParens std_con (interpp'SP tys)
HsUnboxedTuple -> UnboxedTuple
_ -> BoxedTuple
ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> ppr kind)
-ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty _ (HsPArrTy ty) = paBrackets (ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty _ (HsPArrTy ty) = paBrackets (ppr_mono_lty pREC_TOP ty)
ppr_mono_ty prec (HsIParamTy n ty) = maybeParen prec pREC_FUN (ppr n <+> dcolon <+> ppr_mono_lty pREC_TOP ty)
ppr_mono_ty _ (HsSpliceTy s _ _) = pprSplice s
ppr_mono_ty _ (HsCoreTy ty) = ppr ty
@@ -612,7 +620,7 @@ ppr_mono_ty _ (HsParTy ty)
= parens (ppr_mono_lty pREC_TOP ty)
-- Put the parens in where the user did
-- But we still use the precedence stuff to add parens because
- -- toHsType doesn't put in any HsParTys, so we may still need them
+ -- toHsType doesn't put in any HsParTys, so we may still need them
ppr_mono_ty ctxt_prec (HsDocTy ty doc)
= maybeParen ctxt_prec pREC_OP $
@@ -624,7 +632,7 @@ ppr_mono_ty ctxt_prec (HsDocTy ty doc)
ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
ppr_fun_ty ctxt_prec ty1 ty2
= let p1 = ppr_mono_lty pREC_FUN ty1
- p2 = ppr_mono_lty pREC_TOP ty2
+ p2 = ppr_mono_lty pREC_TOP ty2
in
maybeParen ctxt_prec pREC_FUN $
sep [p1, ptext (sLit "->") <+> p2]
@@ -635,3 +643,4 @@ ppr_tylit (HsNumTy i) = integer i
ppr_tylit (HsStrTy s) = text (show s)
\end{code}
+
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index d2fdc51bb1..15e488bd09 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -90,7 +90,6 @@ module GHC (
findModule, lookupModule,
#ifdef GHCI
isModuleTrusted,
- setGHCiMonad,
setContext, getContext,
getNamesInScope,
getRdrNamesInScope,
@@ -1331,18 +1330,6 @@ isModuleTrusted :: GhcMonad m => Module -> m Bool
isModuleTrusted m = withSession $ \hsc_env ->
liftIO $ hscCheckSafe hsc_env m noSrcSpan
--- | Set the monad GHCi lifts user statements into.
---
--- Checks that a type (in string form) is an instance of the
--- @GHC.GHCi.GHCiSandboxIO@ type class. Sets it to be the GHCi monad if it is,
--- throws an error otherwise.
-setGHCiMonad :: GhcMonad m => String -> m ()
-setGHCiMonad name = withSession $ \hsc_env -> do
- ty <- liftIO $ hscIsGHCiMonad hsc_env name
- modifySession $ \s ->
- let ic = (hsc_IC s) { ic_monad = ty }
- in s { hsc_IC = ic }
-
getHistorySpan :: GhcMonad m => History -> m SrcSpan
getHistorySpan h = withSession $ \hsc_env ->
return $ InteractiveEval.getHistorySpan hsc_env h
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index b3f79605a1..491814f0c5 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -62,7 +62,6 @@ module HscMain
, hscTcRnGetInfo
, hscCheckSafe
#ifdef GHCI
- , hscIsGHCiMonad
, hscGetModuleInterface
, hscRnImportDecls
, hscTcRnLookupRdrName
@@ -312,11 +311,6 @@ hscTcRnGetInfo hsc_env0 name = runInteractiveHsc hsc_env0 $ do
ioMsgMaybe' $ tcRnGetInfo hsc_env name
#ifdef GHCI
-hscIsGHCiMonad :: HscEnv -> String -> IO Name
-hscIsGHCiMonad hsc_env name =
- let icntxt = hsc_IC hsc_env
- in runHsc hsc_env $ ioMsgMaybe $ isGHCiMonad hsc_env icntxt name
-
hscGetModuleInterface :: HscEnv -> Module -> IO ModIface
hscGetModuleInterface hsc_env0 mod = runInteractiveHsc hsc_env0 $ do
hsc_env <- getHscEnv
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 82712e2741..e55d78e6fd 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -136,7 +136,7 @@ import Annotations
import Class
import TyCon
import DataCon
-import PrelNames ( gHC_PRIM, ioTyConName )
+import PrelNames ( gHC_PRIM )
import Packages hiding ( Version(..) )
import DynFlags
import DriverPhases
@@ -910,9 +910,6 @@ data InteractiveContext
-- ^ The 'DynFlags' used to evaluate interative expressions
-- and statements.
- ic_monad :: Name,
- -- ^ The monad that GHCi is executing in
-
ic_imports :: [InteractiveImport],
-- ^ The GHCi context is extended with these imports
--
@@ -976,8 +973,6 @@ hscDeclsWithLocation) and save them in ic_sys_vars.
emptyInteractiveContext :: DynFlags -> InteractiveContext
emptyInteractiveContext dflags
= InteractiveContext { ic_dflags = dflags,
- -- IO monad by default
- ic_monad = ioTyConName,
ic_imports = [],
ic_rn_gbl_env = emptyGlobalRdrEnv,
ic_tythings = [],
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index c6c3ed719a..9b47edb169 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -306,9 +306,6 @@ basicKnownKeyNames
, guardMName
, liftMName
, mzipName
-
- -- GHCi Sandbox
- , ghciIoClassName, ghciStepIoMName
]
genericTyConNames :: [Name]
@@ -337,7 +334,7 @@ pRELUDE = mkBaseModule_ pRELUDE_NAME
gHC_PRIM, gHC_TYPES, gHC_GENERICS,
gHC_MAGIC,
- gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_CSTRING,
+ gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_CSTRING,
gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER_TYPE, gHC_LIST,
gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING, dATA_FOLDABLE, dATA_TRAVERSABLE,
gHC_CONC, gHC_IO, gHC_IO_Exception,
@@ -356,7 +353,6 @@ gHC_CLASSES = mkPrimModule (fsLit "GHC.Classes")
gHC_BASE = mkBaseModule (fsLit "GHC.Base")
gHC_ENUM = mkBaseModule (fsLit "GHC.Enum")
-gHC_GHCI = mkBaseModule (fsLit "GHC.GHCi")
gHC_SHOW = mkBaseModule (fsLit "GHC.Show")
gHC_READ = mkBaseModule (fsLit "GHC.Read")
gHC_NUM = mkBaseModule (fsLit "GHC.Num")
@@ -975,19 +971,15 @@ datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassKey
constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey
selectorClassName = clsQual gHC_GENERICS (fsLit "Selector") selectorClassKey
--- GHCi things
-ghciIoClassName, ghciStepIoMName :: Name
-ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey
-ghciStepIoMName = methName gHC_GHCI (fsLit "ghciStepIO") ghciStepIoMClassOpKey
-
-- IO things
-ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName, failIOName :: Name
-ioTyConName = tcQual gHC_TYPES (fsLit "IO") ioTyConKey
-ioDataConName = conName gHC_TYPES (fsLit "IO") ioDataConKey
-thenIOName = varQual gHC_BASE (fsLit "thenIO") thenIOIdKey
-bindIOName = varQual gHC_BASE (fsLit "bindIO") bindIOIdKey
-returnIOName = varQual gHC_BASE (fsLit "returnIO") returnIOIdKey
-failIOName = varQual gHC_IO (fsLit "failIO") failIOIdKey
+ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName,
+ failIOName :: Name
+ioTyConName = tcQual gHC_TYPES (fsLit "IO") ioTyConKey
+ioDataConName = conName gHC_TYPES (fsLit "IO") ioDataConKey
+thenIOName = varQual gHC_BASE (fsLit "thenIO") thenIOIdKey
+bindIOName = varQual gHC_BASE (fsLit "bindIO") bindIOIdKey
+returnIOName = varQual gHC_BASE (fsLit "returnIO") returnIOIdKey
+failIOName = varQual gHC_IO (fsLit "failIO") failIOIdKey
-- IO things
printName :: Name
@@ -1187,9 +1179,6 @@ selectorClassKey = mkPreludeClassUnique 41
singIClassNameKey, typeNatLeqClassNameKey :: Unique
singIClassNameKey = mkPreludeClassUnique 42
typeNatLeqClassNameKey = mkPreludeClassUnique 43
-
-ghciIoClassKey :: Unique
-ghciIoClassKey = mkPreludeClassUnique 44
\end{code}
%************************************************************************
@@ -1658,11 +1647,6 @@ guardMIdKey = mkPreludeMiscIdUnique 194
liftMIdKey = mkPreludeMiscIdUnique 195
mzipIdKey = mkPreludeMiscIdUnique 196
--- GHCi
-ghciStepIoMClassOpKey, ghciShowIoMClassOpKey :: Unique
-ghciStepIoMClassOpKey = mkPreludeMiscIdUnique 197
-ghciShowIoMClassOpKey = mkPreludeMiscIdUnique 198
-
---------------- Template Haskell -------------------
-- USES IdUniques 200-499
diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 65f0c0c1a8..488e65458c 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -939,7 +939,7 @@ tcSyntaxOp :: CtOrigin -> HsExpr Name -> TcType -> TcM (HsExpr TcId)
-- This version assumes res_ty is a monotype
tcSyntaxOp orig (HsVar op) res_ty = do { (expr, rho) <- tcInferIdWithOrig orig op
; tcWrapResult expr rho res_ty }
-tcSyntaxOp _ other _ = pprPanic "tcSyntaxOp: " (ppr other)
+tcSyntaxOp _ other _ = pprPanic "tcSyntaxOp" (ppr other)
\end{code}
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 2e33e1f33d..0128f1809e 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -12,7 +12,6 @@ module TcRnDriver (
tcRnLookupRdrName,
getModuleInterface,
tcRnDeclsi,
- isGHCiMonad,
#endif
tcRnLookupName,
tcRnGetInfo,
@@ -25,7 +24,6 @@ module TcRnDriver (
import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
#endif
-import TypeRep
import DynFlags
import StaticFlags
import HsSyn
@@ -1288,7 +1286,6 @@ tcUserStmt :: LStmt RdrName -> TcM PlanResult
tcUserStmt (L loc (ExprStmt expr _ _ _))
= do { (rn_expr, fvs) <- checkNoErrs (rnLExpr expr)
-- Don't try to typecheck if the renamer fails!
- ; ghciStep <- getGhciStepIO
; uniq <- newUnique
; let fresh_it = itName uniq loc
matches = [mkMatch [] rn_expr emptyLocalBinds]
@@ -1298,15 +1295,13 @@ tcUserStmt (L loc (ExprStmt expr _ _ _))
-- free variables, and they in turn may have free type variables
-- (if we are at a breakpoint, say). We must put those free vars
+
-- [let it = expr]
let_stmt = L loc $ LetStmt $ HsValBinds $
ValBindsOut [(NonRecursive,unitBag the_bind)] []
-
-- [it <- e]
- bind_stmt = L loc $ BindStmt (L loc (VarPat fresh_it))
- (nlHsApp ghciStep rn_expr)
+ bind_stmt = L loc $ BindStmt (L loc (VarPat fresh_it)) rn_expr
(HsVar bindIOName) noSyntaxExpr
-
-- [; print it]
print_it = L loc $ ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar fresh_it))
(HsVar thenIOName) noSyntaxExpr placeHolderType
@@ -1324,7 +1319,7 @@ tcUserStmt (L loc (ExprStmt expr _ _ _))
-- Plan A
do { stuff@([it_id], _) <- tcGhciStmts [bind_stmt, print_it]
; it_ty <- zonkTcType (idType it_id)
- ; when (isUnitTy $ it_ty) failM
+ ; when (isUnitTy it_ty) failM
; return stuff },
-- Plan B; a naked bind statment
@@ -1348,26 +1343,20 @@ tcUserStmt rdr_stmt@(L loc _)
; traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs])
; rnDump (ppr rn_stmt) ;
- ; ghciStep <- getGhciStepIO
- ; let gi_stmt
- | (L loc (BindStmt pat expr op1 op2)) <- rn_stmt
- = L loc $ BindStmt pat (nlHsApp ghciStep expr) op1 op2
- | otherwise = rn_stmt
-
; opt_pr_flag <- doptM Opt_PrintBindResult
; let print_result_plan
| opt_pr_flag -- The flag says "print result"
- , [v] <- collectLStmtBinders gi_stmt -- One binder
- = [mk_print_result_plan gi_stmt v]
+ , [v] <- collectLStmtBinders rn_stmt -- One binder
+ = [mk_print_result_plan rn_stmt v]
| otherwise = []
-- The plans are:
-- [stmt; print v] if one binder and not v::()
-- [stmt] otherwise
- ; runPlans (print_result_plan ++ [tcGhciStmts [gi_stmt]]) }
+ ; runPlans (print_result_plan ++ [tcGhciStmts [rn_stmt]]) }
where
- mk_print_result_plan stmt v
- = do { stuff@([v_id], _) <- tcGhciStmts [stmt, print_v]
+ mk_print_result_plan rn_stmt v
+ = do { stuff@([v_id], _) <- tcGhciStmts [rn_stmt, print_v]
; v_ty <- zonkTcType (idType v_id)
; when (isUnitTy v_ty || not (isTauTy v_ty)) failM
; return stuff }
@@ -1422,40 +1411,6 @@ tcGhciStmts stmts
return (ids, mkHsDictLet (EvBinds const_binds) $
noLoc (HsDo GhciStmt stmts io_ret_ty))
}
-
--- | Generate a typed ghciStepIO expression (ghciStep :: Ty a -> IO a)
-getGhciStepIO :: TcM (LHsExpr Name)
-getGhciStepIO = do
- ghciTy <- getGHCiMonad
- fresh_a <- newUnique
- let a_tv = mkTcTyVarName fresh_a (fsLit "a")
- ghciM = nlHsAppTy (nlHsTyVar ghciTy) (nlHsTyVar a_tv)
- ioM = nlHsAppTy (nlHsTyVar ioTyConName) (nlHsTyVar a_tv)
- stepTy = noLoc $ HsForAllTy Implicit
- ([noLoc $ UserTyVar a_tv])
- (noLoc [])
- (nlHsFunTy ghciM ioM)
- step = noLoc $ ExprWithTySig (nlHsVar ghciStepIoMName) stepTy
- return step
-
-isGHCiMonad :: HscEnv -> InteractiveContext -> String -> IO (Messages, Maybe Name)
-isGHCiMonad hsc_env ictxt ty
- = initTcPrintErrors hsc_env iNTERACTIVE $
- setInteractiveContext hsc_env ictxt $ do
- rdrEnv <- getGlobalRdrEnv
- let occIO = lookupOccEnv rdrEnv (mkOccName tcName ty)
- case occIO of
- Just [n] -> do
- let name = gre_name n
- ghciClass <- tcLookupClass ghciIoClassName
- userTyCon <- tcLookupTyCon name
- let userTy = TyConApp userTyCon []
- _ <- tcLookupInstance ghciClass [userTy]
- return name
-
- Just _ -> failWithTc $ text "Ambigous type!"
- Nothing -> failWithTc $ text ("Can't find type:" ++ ty)
-
\end{code}
tcRnExpr just finds the type of an expression
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 2f821b3aae..0d20be2949 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -486,9 +486,6 @@ setModule mod thing_inside = updGblEnv (\env -> env { tcg_mod = mod }) thing_ins
getIsGHCi :: TcRn Bool
getIsGHCi = do { mod <- getModule; return (mod == iNTERACTIVE) }
-getGHCiMonad :: TcRn Name
-getGHCiMonad = do { hsc <- getTopEnv; return (ic_monad $ hsc_IC hsc) }
-
tcIsHsBoot :: TcRn Bool
tcIsHsBoot = do { env <- getGblEnv; return (isHsBoot (tcg_src env)) }
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index c576b6b5fb..8d6e23c678 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -144,7 +144,6 @@ builtin_commands = [
("quit", quit, noCompletion),
("reload", keepGoing' reloadModule, noCompletion),
("run", keepGoing runRun, completeFilename),
- ("runmonad", keepGoing setRunMonad, noCompletion),
("script", keepGoing' scriptCmd, completeFilename),
("set", keepGoing setCmd, completeSetOptions),
("seti", keepGoing setiCmd, completeSeti),
@@ -1488,14 +1487,6 @@ isSafeModule m = do
part pkg = trusted $ getPackageDetails state pkg
-----------------------------------------------------------------------------
--- :runmonad
-
--- Set the monad GHCi should execute in
-
-setRunMonad :: String -> GHCi ()
-setRunMonad name = GHC.setGHCiMonad name
-
------------------------------------------------------------------------------
-- :browse
-- Browsing a module's contents