Keep track of free type variables in the interactive bindings

[ghc-hetmet.git] / compiler / main / HscMain.lhs

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 4413c52..50a015f 100644 (file)
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -25,8 +25,7 @@ module HscMain
 #include "HsVersions.h"
 
 #ifdef GHCI
-import HsSyn           ( Stmt(..), LHsExpr, LStmt, LHsType )
-import Module          ( Module )
+import HsSyn           ( Stmt(..), LStmt, LHsType )
 import CodeOutput      ( outputForeignStubs )
 import ByteCodeGen     ( byteCodeGen, coreExprToBCOs )
 import Linker          ( HValue, linkExpr )
@@ -43,6 +42,7 @@ import {- Kind parts of -} Type               ( Kind )
 import CoreLint                ( lintUnfolding )
 import DsMeta          ( templateHaskellNames )
 import SrcLoc          ( SrcSpan, noSrcLoc, interactiveSrcLoc, srcLocSpan )
+import VarSet
 import VarEnv          ( emptyTidyEnv )
 #endif
 
@@ -797,7 +797,7 @@ A naked expression returns a singleton Name [it].
 hscStmt                -- Compile a stmt all the way to an HValue, but don't run it
   :: HscEnv
   -> String                    -- The statement
-  -> IO (Maybe (HscEnv, [Name], HValue))
+  -> IO (Maybe (InteractiveContext, [Name], HValue))
 
 hscStmt hsc_env stmt
   = do { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) stmt
@@ -828,7 +828,7 @@ hscStmt hsc_env stmt
        ; let src_span = srcLocSpan interactiveSrcLoc
        ; hval <- compileExpr hsc_env src_span ds_expr
 
-       ; return (Just (hsc_env{ hsc_IC=new_ic }, bound_names, hval))
+       ; return (Just (new_ic, bound_names, hval))
        }}}}}}}
 
 hscTcExpr      -- Typecheck an expression (but don't run it)
@@ -934,7 +934,10 @@ compileExpr hsc_env srcspan ds_expr
                -- Lint if necessary
                -- ToDo: improve SrcLoc
        ; if lint_on then 
-               case lintUnfolding noSrcLoc [] prepd_expr of
+                let ictxt = hsc_IC hsc_env
+                    tyvars = varSetElems (ic_tyvars ictxt)
+                in
+               case lintUnfolding noSrcLoc tyvars prepd_expr of
                   Just err -> pprPanic "compileExpr" err
                   Nothing  -> return ()
          else