Revert "Added ':runmonad' command to GHCi"
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 13 Apr 2012 09:37:48 +0000 (10:37 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 13 Apr 2012 09:37:48 +0000 (10:37 +0100)
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.

compiler/hsSyn/HsTypes.lhs
compiler/main/GHC.hs
compiler/main/HscMain.hs
compiler/main/HscTypes.lhs
compiler/prelude/PrelNames.lhs
compiler/typecheck/TcExpr.lhs
compiler/typecheck/TcRnDriver.lhs
compiler/typecheck/TcRnMonad.lhs
ghc/InteractiveUI.hs

index b41070b..9e8d27b 100644 (file)
@@ -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}
 
+
index d2fdc51..15e488b 100644 (file)
@@ -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
index b3f7960..491814f 100644 (file)
@@ -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
index 82712e2..e55d78e 100644 (file)
@@ -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   = [],
index c6c3ed7..9b47edb 100644 (file)
@@ -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
index 65f0c0c..488e654 100644 (file)
@@ -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}
 
 
index 2e33e1f..0128f18 100644 (file)
@@ -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
index 2f821b3..0d20be2 100644 (file)
@@ -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)) }
 
index c576b6b..8d6e23c 100644 (file)
@@ -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