+ return (stg_binds2, cost_centre_info, env_rhs)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Compiling a do-statement}
+%* *
+%************************************************************************
+
+\begin{code}
+#ifdef GHCI
+hscStmt
+ :: DynFlags
+ -> HomeSymbolTable
+ -> HomeIfaceTable
+ -> PersistentCompilerState -- IN: persistent compiler state
+ -> InteractiveContext -- Context for compiling
+ -> String -- The statement
+ -> Bool -- just treat it as an expression
+ -> IO ( PersistentCompilerState,
+ Maybe ( [Id],
+ Type,
+ UnlinkedBCOExpr) )
+\end{code}
+
+When the UnlinkedBCOExpr is linked you get an HValue of type
+ IO [HValue]
+When you run it you get a list of HValues that should be
+the same length as the list of names; add them to the ClosureEnv.
+
+A naked expression returns a singleton Name [it].
+
+ 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 [v]
+ [NB: result not printed] bindings: [it]
+
+
+ expr (of non-IO type,
+ result showable) ==> let v = expr in print v >> return [v]
+ bindings: [it]
+
+ expr (of non-IO type,
+ result not showable) ==> error
+
+\begin{code}
+hscStmt dflags hst hit pcs0 icontext stmt just_expr
+ = do { maybe_stmt <- hscParseStmt dflags stmt
+ ; case maybe_stmt of
+ Nothing -> return (pcs0, Nothing)
+ Just parsed_stmt -> do {
+
+ let { notExprStmt (ExprStmt _ _ _) = False;
+ notExprStmt _ = True
+ };
+
+ if (just_expr && notExprStmt parsed_stmt)
+ then do hPutStrLn stderr ("not an expression: `" ++ stmt ++ "'")
+ return (pcs0, Nothing)
+ else do {
+
+ -- Rename it
+ (pcs1, print_unqual, maybe_renamed_stmt)
+ <- renameStmt dflags hit hst pcs0
+ iNTERACTIVE icontext parsed_stmt
+
+ ; case maybe_renamed_stmt of
+ Nothing -> return (pcs0, Nothing)
+ Just (bound_names, rn_stmt) -> do {
+
+ -- Typecheck it
+ maybe_tc_return <-
+ if just_expr
+ then case rn_stmt of { (ExprStmt e _ _, decls) ->
+ typecheckExpr dflags pcs1 hst (ic_type_env icontext)
+ print_unqual iNTERACTIVE (e,decls) }
+ else typecheckStmt dflags pcs1 hst (ic_type_env icontext)
+ print_unqual iNTERACTIVE bound_names rn_stmt
+
+ ; case maybe_tc_return of
+ Nothing -> return (pcs0, Nothing)
+ Just (pcs2, tc_expr, bound_ids, ty) -> do {
+
+ -- Desugar it
+ ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr
+
+ -- Simplify it
+ ; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr
+
+ -- Tidy it (temporary, until coreSat does cloning)
+ ; tidy_expr <- tidyCoreExpr simpl_expr
+
+ -- Prepare for codegen
+ ; prepd_expr <- corePrepExpr dflags tidy_expr
+
+ -- Convert to BCOs
+ ; bcos <- coreExprToBCOs dflags prepd_expr
+
+ ; 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_bound_ids = map globaliseId bound_ids;
+ globaliseId id = setGlobalIdDetails id VanillaGlobal
+
+ ; return (pcs2, Just (global_bound_ids, ty, bcos))
+
+ }}}}}
+
+hscParseStmt :: DynFlags -> String -> IO (Maybe RdrNameStmt)
+hscParseStmt dflags str
+ = do -------------------------- Parser ----------------
+ showPass dflags "Parser"
+ _scc_ "Parser" do