[project @ 2003-01-06 15:27:11 by simonpj]

Make HscMain.compileExpr run lint if -dcore-lint is on

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 3c2d652..c532871 100644 (file)
--- 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