X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscMain.lhs;h=42ed3e45989e44880ce8d51b5112d0e29f316199;hb=6193ff066266120cd18712e0663dfae36034aa51;hp=76c35ea1e6d0fbd95597db649fe95df242b9f583;hpb=de1a1f9f882cf1a5c81c4a152edc001aafd3f8a3;p=ghc-hetmet.git

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 76c35ea..42ed3e4 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -46,14 +46,16 @@ import CorePrep		( corePrepExpr )
 import Desugar          ( deSugarExpr )
 import SimplCore        ( simplifyExpr )
 import TcRnDriver	( tcRnStmt, tcRnExpr, tcRnType ) 
-import Type		( Type )
+import Type		( Type, tyVarsOfTypes )
 import PrelNames	( iNTERACTIVE )
 import {- Kind parts of -} Type		( Kind )
+import Id      	     	( idType )
 import CoreLint		( lintUnfolding )
 import DsMeta		( templateHaskellNames )
 import SrcLoc		( SrcSpan, noSrcLoc, interactiveSrcLoc, srcLocSpan, noSrcSpan, unLoc )
 import VarSet
 import VarEnv		( emptyTidyEnv )
+import Panic
 #endif
 
 import Id		( Id )
@@ -148,9 +150,7 @@ newHscEnv callbacks dflags
 			   hsc_FC      = fc_var,
 			   hsc_MLC     = mlc_var,
 			   hsc_OptFuel = optFuel,
-                           hsc_type_env_var = Nothing,
-                           hsc_global_rdr_env = emptyGlobalRdrEnv,
-                           hsc_global_type_env = emptyNameEnv } ) }
+                           hsc_type_env_var = Nothing } ) }
 
 
 knownKeyNames :: [Name]	-- Put here to avoid loops involving DsMeta,
@@ -186,7 +186,7 @@ hscParse mod_summary = do
 
    let loc  = mkSrcLoc (mkFastString src_filename) 1 1
 
-   case unP parseModule (mkPState buf loc dflags) of
+   case unP parseModule (mkPState dflags buf loc) of
      PFailed span err ->
          throwOneError (mkPlainErrMsg span err)
 
@@ -996,7 +996,7 @@ hscParseThing parser dflags str
 
       let loc  = mkSrcLoc (fsLit "<interactive>") 1 1
 
-      case unP parser (mkPState buf loc dflags) of
+      case unP parser (mkPState dflags buf loc) of
 
 	PFailed span err -> do
           let msg = mkPlainErrMsg span err
@@ -1026,6 +1026,11 @@ hscParseThing parser dflags str
 compileExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO HValue
 
 compileExpr hsc_env srcspan ds_expr
+  | rtsIsProfiled
+  = throwIO (InstallationError "You can't call compileExpr in a profiled compiler")
+    	  -- Otherwise you get a seg-fault when you run it
+
+  | otherwise
   = do	{ let { dflags  = hsc_dflags hsc_env ;
 		lint_on = dopt Opt_DoCoreLinting dflags }
 	      
@@ -1042,7 +1047,7 @@ compileExpr hsc_env srcspan ds_expr
 		-- ToDo: improve SrcLoc
 	; if lint_on then 
                 let ictxt = hsc_IC hsc_env
-                    tyvars = varSetElems (ic_tyvars ictxt)
+                    tyvars = varSetElems (tyVarsOfTypes (map idType (ic_tmp_ids ictxt)))
                 in
 		case lintUnfolding noSrcLoc tyvars prepd_expr of
 		   Just err -> pprPanic "compileExpr" err