Deprecate -fglasgow-exts

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

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index b183250..93ad614 100644 (file)
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -14,7 +14,7 @@ module HscMain
     , hscSimplify
     , hscNormalIface, hscWriteIface, hscGenHardCode
 #ifdef GHCI
-    , hscStmt, hscTcExpr, hscKcType
+    , hscStmt, hscTcExpr, hscImport, hscKcType
     , compileExpr
 #endif
     , HsCompiler(..)
@@ -51,9 +51,10 @@ import PrelNames     ( iNTERACTIVE )
 import {- Kind parts of -} Type                ( Kind )
 import CoreLint                ( lintUnfolding )
 import DsMeta          ( templateHaskellNames )
-import SrcLoc          ( SrcSpan, noSrcLoc, interactiveSrcLoc, srcLocSpan, noSrcSpan )
+import SrcLoc          ( SrcSpan, noSrcLoc, interactiveSrcLoc, srcLocSpan, noSrcSpan, unLoc )
 import VarSet
 import VarEnv          ( emptyTidyEnv )
+import Panic
 #endif
 
 import Id              ( Id )
@@ -186,7 +187,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)
 
@@ -931,6 +932,12 @@ hscStmt hsc_env stmt = do
 
        return $ Just (ids, hval)
 
+hscImport :: GhcMonad m => HscEnv -> String -> m (ImportDecl RdrName)
+hscImport hsc_env str = do
+    (L _ (HsModule{hsmodImports=is})) <- hscParseThing parseModule (hsc_dflags hsc_env) str
+    case is of
+        [i] -> return (unLoc i)
+        _ -> throwOneError (mkPlainErrMsg noSrcSpan (ptext (sLit "parse error in import declaration")))
 
 hscTcExpr      -- Typecheck an expression (but don't run it)
   :: GhcMonad m =>
@@ -990,7 +997,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
@@ -1020,6 +1027,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 }