+%************************************************************************
+%* *
+\subsection{Compiling an expression}
+%* *
+%************************************************************************
+
+\begin{code}
+#ifndef GHCI
+hscExpr dflags hst hit pcs this_module expr
+ = panic "hscExpr: non-interactive build"
+hscTypeExpr dflags hst hit pcs0 this_module expr
+ = panic "hscTypeExpr: non-interactive build"
+#else
+
+hscExpr
+ :: DynFlags
+ -> HomeSymbolTable
+ -> HomeIfaceTable
+ -> PersistentCompilerState -- IN: persistent compiler state
+ -> Module -- Context for compiling
+ -> String -- The expression
+ -> IO ( PersistentCompilerState,
+ Maybe (UnlinkedIExpr, PrintUnqualified, Type) )
+
+hscExpr dflags hst hit pcs0 this_module expr
+ = do {
+ maybe_parsed <- hscParseExpr dflags expr;
+ case maybe_parsed of
+ Nothing -> return (pcs0, Nothing)
+ Just parsed_expr -> do {
+
+ -- Rename it
+ (pcs1, maybe_renamed_expr) <-
+ renameExpr dflags hit hst pcs0 this_module parsed_expr;
+ case maybe_renamed_expr of
+ Nothing -> return (pcs1, Nothing)
+ Just (print_unqual, rn_expr) -> do {
+
+ -- Typecheck it
+ maybe_tc_return
+ <- typecheckExpr dflags pcs1 hst print_unqual this_module rn_expr;
+ case maybe_tc_return of {
+ Nothing -> return (pcs1, Nothing);
+ Just (pcs2, tc_expr, ty) -> do
+
+ -- if it isn't an IO-typed expression,
+ -- wrap "print" around it & recompile...
+ let { is_IO_type = case splitTyConApp_maybe ty of {
+ Just (tycon, _) -> getUnique tycon == ioTyConKey;
+ Nothing -> False }
+ };
+
+ if (not is_IO_type)
+ then do (new_pcs, maybe_stuff)
+ <- hscExpr dflags hst hit pcs2 this_module
+ ("print (" ++ expr ++ ")")
+ case maybe_stuff of
+ Nothing -> return (new_pcs, maybe_stuff)
+ Just (expr, _, _) ->
+ return (new_pcs, Just (expr, print_unqual, ty))
+ else do
+
+ -- Desugar it
+ ds_expr <- deSugarExpr dflags pcs2 hst this_module
+ print_unqual tc_expr;
+
+ -- Simplify it
+ simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr;
+
+ -- Saturate it
+ sat_expr <- coreSatExpr dflags simpl_expr;
+
+ -- Convert to STG
+ let stg_expr = coreExprToStg sat_expr;
+
+ -- ToDo: need to do SRTs?
+
+ -- Convert to InterpSyn
+ unlinked_iexpr <- stgExprToInterpSyn dflags stg_expr;
+
+ return (pcs2, Just (unlinked_iexpr, print_unqual, ty));
+ }}}}
+
+hscParseExpr :: DynFlags -> String -> IO (Maybe RdrNameHsExpr)
+hscParseExpr dflags str
+ = do -------------------------- Parser ----------------
+ showPass dflags "Parser"
+ -- _scc_ "Parser"
+
+ buf <- stringToStringBuffer ("__expr " ++ str)
+
+ -- glaexts is True for now (because of the daft __expr at the front
+ -- of the string...)
+ let glaexts = 1#
+ --let glaexts | dopt Opt_GlasgowExts dflags = 1#
+ -- | otherwise = 0#
+
+ case parse buf PState{ bol = 0#, atbol = 1#,
+ context = [], glasgow_exts = glaexts,
+ loc = mkSrcLoc SLIT("<no file>") 0 } of {
+
+ PFailed err -> do { freeStringBuffer buf;
+ hPutStrLn stderr (showSDoc err);
+ return Nothing };