From b708d7d804d96a80d014f8986c7d808211dac64c Mon Sep 17 00:00:00 2001 From: simonpj Date: Mon, 6 Jan 2003 15:27:11 +0000 Subject: [PATCH] [project @ 2003-01-06 15:27:11 by simonpj] Make HscMain.compileExpr run lint if -dcore-lint is on --- ghc/compiler/main/HscMain.lhs | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 3c2d652..c532871 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -29,6 +29,7 @@ import Type ( Type ) import PrelNames ( iNTERACTIVE ) import StringBuffer ( stringToStringBuffer ) import Name ( Name ) +import CoreLint ( lintUnfolding ) #endif import HsSyn @@ -39,7 +40,7 @@ import IdInfo ( CafInfo(..), CgInfoEnv, CgInfo(..) ) import StringBuffer ( hGetStringBuffer, freeStringBuffer ) import Parser import Lex ( ParseResult(..), ExtFlags(..), mkPState ) -import SrcLoc ( mkSrcLoc ) +import SrcLoc ( mkSrcLoc, noSrcLoc ) import TcRnDriver ( checkOldIface, tcRnModule, tcRnExtCore, tcRnIface ) import RnEnv ( extendOrigNameCache ) import Rules ( emptyRuleBase ) @@ -638,8 +639,9 @@ compileExpr :: HscEnv -> IO HValue compileExpr hsc_env pcs this_mod rdr_env type_env tc_expr - = do { let dflags = hsc_dflags hsc_env - + = do { let { dflags = hsc_dflags hsc_env ; + lint_on = dopt Opt_DoCoreLinting dflags } + -- Desugar it ; ds_expr <- deSugarExpr hsc_env pcs this_mod rdr_env type_env tc_expr @@ -655,6 +657,15 @@ compileExpr hsc_env pcs this_mod rdr_env type_env tc_expr -- Prepare for codegen ; prepd_expr <- corePrepExpr dflags tidy_expr + -- Lint if necessary + -- ToDo: improve SrcLoc + ; if lint_on then + case lintUnfolding noSrcLoc [] prepd_expr of + Just err -> pprPanic "compileExpr" err + Nothing -> return () + else + return () + -- Convert to BCOs ; bcos <- coreExprToBCOs dflags prepd_expr -- 1.7.10.4