-tcRnStmt :: HscEnv -> PersistentCompilerState
- -> InteractiveContext
- -> RdrNameStmt
- -> IO (PersistentCompilerState,
- Maybe (InteractiveContext, [Name], TypecheckedHsExpr))
- -- The returned [Id] is the same as the input except for
- -- ExprStmt, in which case the returned [Name] is [itName]
-
-tcRnStmt hsc_env pcs ictxt rdr_stmt
- = initTc hsc_env pcs iNTERACTIVE $
- setInteractiveContext ictxt $ do {
-
- -- Rename; use CmdLineMode because tcRnStmt is only used interactively
- ([rn_stmt], fvs) <- initRnInteractive ictxt
- (rnStmts DoExpr [rdr_stmt]) ;
- traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
- failIfErrsM ;
-
- -- Suck in the supporting declarations and typecheck them
- tcg_env <- importSupportingDecls (fvs `plusFV` implicitStmtFVs fvs) ;
- -- NB: an earlier version deleted (rdrEnvElts local_env) from
- -- the fvs. But (a) that isn't necessary, because previously
- -- bound things in the local_env will be in the TypeEnv, and
- -- the renamer doesn't re-slurp such things, and
- -- (b) it's WRONG to delete them. Consider in GHCi:
- -- Mod> let x = e :: T
- -- Mod> let y = x + 3
- -- We need to pass 'x' among the fvs to slurpImpDecls, so that
- -- the latter can see that T is a gate, and hence import the Num T
- -- instance decl. (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
- setGblEnv tcg_env $ do {
-
- -- The real work is done here
- ((bound_ids, tc_expr), lie) <- getLIE (tcUserStmt rn_stmt) ;
-
- traceTc (text "tcs 1") ;
- let { -- Make all the bound ids "global" ids, now that
- -- they're notionally top-level bindings. This is
- -- important: otherwise when we come to compile an expression
- -- using these ids later, the byte code generator will consider
- -- the occurrences to be free rather than global.
- global_ids = map globaliseId bound_ids ;
- globaliseId id = setGlobalIdDetails id VanillaGlobal ;
-
- -- Update the interactive context
- rn_env = ic_rn_local_env ictxt ;
- type_env = ic_type_env ictxt ;
-
- bound_names = map idName global_ids ;
- new_rn_env = extendLocalRdrEnv rn_env bound_names ;
-
- -- Remove any shadowed bindings from the type_env;
- -- they are inaccessible but might, I suppose, cause
- -- a space leak if we leave them there
- shadowed = [ n | name <- bound_names,
- let rdr_name = mkRdrUnqual (nameOccName name),
- Just n <- [lookupRdrEnv rn_env rdr_name] ] ;
-
- filtered_type_env = delListFromNameEnv type_env shadowed ;
- new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
-
- new_ic = ictxt { ic_rn_local_env = new_rn_env,
- ic_type_env = new_type_env }
- } ;
-
- dumpOptTcRn Opt_D_dump_tc
- (vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
- text "Typechecked expr" <+> ppr tc_expr]) ;
-
- returnM (new_ic, bound_names, tc_expr)
- }}
-\end{code}
-
-
-Here is the grand plan, implemented in tcUserStmt
-
- What you type The IO [HValue] that hscStmt returns
- ------------- ------------------------------------
- let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
- bindings: [x,y,...]
-
- pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
- bindings: [x,y,...]
-
- expr (of IO type) ==> expr >>= \ v -> return [coerce HVal v]
- [NB: result not printed] bindings: [it]
-
- expr (of non-IO type, ==> let v = expr in print v >> return [coerce HVal v]
- result showable) bindings: [it]
-
- expr (of non-IO type,
- result not showable) ==> error
-
-
-\begin{code}
----------------------------
-tcUserStmt :: RenamedStmt -> TcM ([Id], TypecheckedHsExpr)
-tcUserStmt (ExprStmt expr _ loc)
- = newUnique `thenM` \ uniq ->
- let
- fresh_it = itName uniq
- the_bind = FunMonoBind fresh_it False
- [ mkSimpleMatch [] expr placeHolderType loc ] loc
- in
- tryTcLIE_ (do { -- Try this if the other fails
- traceTc (text "tcs 1b") ;
- tc_stmts [
- LetStmt (MonoBind the_bind [] NonRecursive),
- ExprStmt (HsApp (HsVar printName) (HsVar fresh_it))
- placeHolderType loc] })
- (do { -- Try this first
- traceTc (text "tcs 1a") ;
- tc_stmts [BindStmt (VarPat fresh_it) expr loc] })
-
-tcUserStmt stmt = tc_stmts [stmt]
-
----------------------------
-tc_stmts stmts
- = do { io_ids <- mappM tcLookupId
- [returnIOName, failIOName, bindIOName, thenIOName] ;
- ioTyCon <- tcLookupTyCon ioTyConName ;
- res_ty <- newTyVarTy liftedTypeKind ;
- let {
- names = collectStmtsBinders stmts ;
- return_id = head io_ids ; -- Rather gruesome
-
- io_ty = (\ ty -> mkTyConApp ioTyCon [ty], res_ty) ;
-
- -- mk_return builds the expression
- -- returnIO @ [()] [coerce () x, .., coerce () z]
- mk_return ids = HsApp (TyApp (HsVar return_id) [mkListTy unitTy])
- (ExplicitList unitTy (map mk_item ids)) ;
-
- mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
- (HsVar id) } ;
-
- -- OK, we're ready to typecheck the stmts
- traceTc (text "tcs 2") ;
- ((ids, tc_stmts), lie) <-
- getLIE $ tcStmtsAndThen combine DoExpr io_ty stmts $
- do {
- -- Look up the names right in the middle,
- -- where they will all be in scope
- ids <- mappM tcLookupId names ;
- return (ids, [ResultStmt (mk_return ids) noSrcLoc])
- } ;
-
- -- Simplify the context right here, so that we fail
- -- if there aren't enough instances. Notably, when we see
- -- e
- -- we use recoverTc_ to try it <- e
- -- and then let it = e
- -- It's the simplify step that rejects the first.
- traceTc (text "tcs 3") ;
- const_binds <- tcSimplifyTop lie ;
-
- -- Build result expression and zonk it
- let { expr = mkHsLet const_binds $
- HsDo DoExpr tc_stmts io_ids
- (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc } ;
- zonked_expr <- zonkTopExpr expr ;
- zonked_ids <- zonkTopBndrs ids ;
-
- return (zonked_ids, zonked_expr)
- }
- where
- combine stmt (ids, stmts) = (ids, stmt:stmts)
-\end{code}
-
-
-tcRnExpr just finds the type of an expression
-
-\begin{code}
-tcRnExpr :: HscEnv -> PersistentCompilerState
- -> InteractiveContext
- -> RdrNameHsExpr
- -> IO (PersistentCompilerState, Maybe Type)
-tcRnExpr hsc_env pcs ictxt rdr_expr
- = initTc hsc_env pcs iNTERACTIVE $
- setInteractiveContext ictxt $ do {
-
- (rn_expr, fvs) <- initRnInteractive ictxt (rnExpr rdr_expr) ;
- failIfErrsM ;
-
- -- Suck in the supporting declarations and typecheck them
- tcg_env <- importSupportingDecls (fvs `plusFV` ubiquitousNames) ;
- setGblEnv tcg_env $ do {
-
- -- Now typecheck the expression;
- -- it might have a rank-2 type (e.g. :t runST)
- -- Hence the hole type (c.f. TcExpr.tcExpr_id)
- ((tc_expr, res_ty), lie) <- getLIE (tcExpr_id rn_expr) ;
- ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie) ;
- tcSimplifyTop lie_top ;
-
- let { all_expr_ty = mkForAllTys qtvs $
- mkFunTys (map idType dict_ids) $
- res_ty } ;
- zonkTcType all_expr_ty
- }}
- where
- smpl_doc = ptext SLIT("main expression")
-\end{code}
-
-
-\begin{code}
-tcRnThing :: HscEnv -> PersistentCompilerState
- -> InteractiveContext
- -> RdrName
- -> IO (PersistentCompilerState, Maybe [TyThing])
--- Look up a RdrName and return all the TyThings it might be
--- We treat a capitalised RdrName as both a data constructor
--- and as a type or class constructor; hence we return up to two results
-tcRnThing hsc_env pcs ictxt rdr_name
- = initTc hsc_env pcs iNTERACTIVE $
- setInteractiveContext ictxt $ do {
-
- -- If the identifier is a constructor (begins with an
- -- upper-case letter), then we need to consider both
- -- constructor and type class identifiers.
- let { rdr_names = dataTcOccs rdr_name } ;
-
- (msgs_s, mb_names) <- initRnInteractive ictxt
- (mapAndUnzipM (tryTc . lookupOccRn) rdr_names) ;
- let { names = catMaybes mb_names } ;
-
- if null names then
- do { addMessages (head msgs_s) ; failM }
- else do {