diff options
Diffstat (limited to 'compiler/main/HscMain.hs')
| -rw-r--r-- | compiler/main/HscMain.hs | 48 |
1 files changed, 19 insertions, 29 deletions
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index e884fe5bcf..ad1b7c503a 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -81,9 +81,8 @@ import CoreTidy ( tidyExpr ) import Type ( Type ) import PrelNames import {- Kind parts of -} Type ( Kind ) -import CoreLint ( lintUnfolding ) +import CoreMonad ( lintInteractiveExpr ) import DsMeta ( templateHaskellNames ) -import VarSet import VarEnv ( emptyTidyEnv ) import Panic @@ -1385,12 +1384,12 @@ hscStmtWithLocation hsc_env0 stmt source linenumber = -- Desugar it ds_expr <- ioMsgMaybe $ - deSugarExpr hsc_env iNTERACTIVE rdr_env type_env tc_expr + deSugarExpr hsc_env iNTERACTIVE rdr_env type_env tc_expr + liftIO (lintInteractiveExpr "desugar expression" hsc_env ds_expr) handleWarnings -- Then code-gen, and link it - hsc_env <- getHscEnv - hval <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr + hval <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr let hval_io = unsafeCoerce# hval :: IO [HValue] return $ Just (ids, hval_io, fix_env) @@ -1618,37 +1617,28 @@ hscCompileCoreExpr hsc_env srcspan ds_expr = throwIO (InstallationError "You can't call hscCompileCoreExpr in a profiled compiler") -- Otherwise you get a seg-fault when you run it - | otherwise = do - let dflags = hsc_dflags hsc_env - let lint_on = gopt Opt_DoCoreLinting dflags + | otherwise + = do { let dflags = hsc_dflags hsc_env - {- Simplify it -} - simpl_expr <- simplifyExpr dflags ds_expr + {- Simplify it -} + ; simpl_expr <- simplifyExpr dflags ds_expr - {- Tidy it (temporary, until coreSat does cloning) -} - let tidy_expr = tidyExpr emptyTidyEnv simpl_expr + {- Tidy it (temporary, until coreSat does cloning) -} + ; let tidy_expr = tidyExpr emptyTidyEnv simpl_expr - {- Prepare for codegen -} - prepd_expr <- corePrepExpr dflags hsc_env tidy_expr + {- Prepare for codegen -} + ; prepd_expr <- corePrepExpr dflags hsc_env tidy_expr - {- Lint if necessary -} - -- ToDo: improve SrcLoc - when lint_on $ - let ictxt = hsc_IC hsc_env - te = mkTypeEnvWithImplicits (ic_tythings ictxt ++ map AnId (ic_sys_vars ictxt)) - tyvars = varSetElems $ tyThingsTyVars $ typeEnvElts $ te - vars = typeEnvIds te - in case lintUnfolding noSrcLoc (tyvars ++ vars) prepd_expr of - Just err -> pprPanic "hscCompileCoreExpr" err - Nothing -> return () + {- Lint if necessary -} + ; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr - {- Convert to BCOs -} - bcos <- coreExprToBCOs dflags iNTERACTIVE prepd_expr + {- Convert to BCOs -} + ; bcos <- coreExprToBCOs dflags iNTERACTIVE prepd_expr - {- link it -} - hval <- linkExpr hsc_env srcspan bcos + {- link it -} + ; hval <- linkExpr hsc_env srcspan bcos - return hval + ; return hval } #endif |