Follow changes in Cabal

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

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 312772e..09db7a8 100644 (file)
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -62,7 +62,8 @@ module HscMain
 #ifdef GHCI
     , hscGetModuleExports
     , hscTcRnLookupRdrName
-    , hscStmt, hscTcExpr, hscImport, hscKcType
+    , hscStmt, hscStmtWithLocation
+    , hscTcExpr, hscImport, hscKcType
     , hscCompileCoreExpr
 #endif
 
@@ -161,9 +162,9 @@ import Data.IORef
 newHscEnv :: DynFlags -> IO HscEnv
 newHscEnv dflags
   = do         { eps_var <- newIORef initExternalPackageState
-       ; us      <- mkSplitUniqSupply 'r'
-       ; nc_var  <- newIORef (initNameCache us knownKeyNames)
-       ; fc_var  <- newIORef emptyUFM
+        ; us      <- mkSplitUniqSupply 'r'
+        ; nc_var  <- newIORef (initNameCache us knownKeyNames)
+        ; fc_var  <- newIORef emptyUFM
        ; mlc_var <- newIORef emptyModuleEnv
         ; optFuel <- initOptFuelState
        ; return (HscEnv { hsc_dflags = dflags,
@@ -179,12 +180,13 @@ newHscEnv dflags
                            hsc_type_env_var = Nothing } ) }
 
 
-knownKeyNames :: [Name]        -- Put here to avoid loops involving DsMeta,
-                       -- where templateHaskellNames are defined
-knownKeyNames = map getName wiredInThings 
-             ++ basicKnownKeyNames
+knownKeyNames :: [Name]      -- Put here to avoid loops involving DsMeta,
+                             -- where templateHaskellNames are defined
+knownKeyNames
+  = map getName wiredInThings 
+    ++ basicKnownKeyNames
 #ifdef GHCI
-             ++ templateHaskellNames
+    ++ templateHaskellNames
 #endif
 
 -- -----------------------------------------------------------------------------
@@ -896,7 +898,7 @@ hscGenHardCode cgguts mod_summary
                  -- unless certain dflags are on, the identity function
          ------------------  Code output -----------------------
          rawcmms <- cmmToRawCmm cmms
-         dumpIfSet_dyn dflags Opt_D_dump_cmmz "Raw Cmm" (ppr rawcmms)
+         dumpIfSet_dyn dflags Opt_D_dump_raw_cmm "Raw Cmm" (ppr rawcmms)
          (_stub_h_exists, stub_c_exists)
              <- codeOutput dflags this_mod location foreign_stubs 
                 dependencies rawcmms
@@ -1074,8 +1076,17 @@ hscStmt          -- Compile a stmt all the way to an HValue, but don't run it
   -> String                    -- The statement
   -> IO (Maybe ([Id], HValue))
      -- ^ 'Nothing' <==> empty statement (or comment only), but no parse error
-hscStmt hsc_env stmt = runHsc hsc_env $ do
-    maybe_stmt <- hscParseStmt stmt
+hscStmt hsc_env stmt = hscStmtWithLocation hsc_env stmt "<interactive>" 1
+
+hscStmtWithLocation    -- Compile a stmt all the way to an HValue, but don't run it
+  :: HscEnv
+  -> String                    -- The statement
+  -> String                     -- the source
+  -> Int                        -- ^ starting line
+  -> IO (Maybe ([Id], HValue))
+     -- ^ 'Nothing' <==> empty statement (or comment only), but no parse error
+hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
+    maybe_stmt <- hscParseStmtWithLocation source linenumber stmt
     case maybe_stmt of
       Nothing -> return Nothing
       Just parsed_stmt -> do  -- The real stuff
@@ -1141,6 +1152,11 @@ hscKcType hsc_env str = runHsc hsc_env $ do
 hscParseStmt :: String -> Hsc (Maybe (LStmt RdrName))
 hscParseStmt = hscParseThing parseStmt
 
+hscParseStmtWithLocation :: String -> Int 
+                         -> String -> Hsc (Maybe (LStmt RdrName))
+hscParseStmtWithLocation source linenumber stmt = 
+  hscParseThingWithLocation source linenumber parseStmt stmt
+
 hscParseType :: String -> Hsc (LHsType RdrName)
 hscParseType = hscParseThing parseType
 #endif
@@ -1149,19 +1165,24 @@ hscParseIdentifier :: HscEnv -> String -> IO (Located RdrName)
 hscParseIdentifier hsc_env str = runHsc hsc_env $ 
                                    hscParseThing parseIdentifier str
 
-
 hscParseThing :: (Outputable thing)
              => Lexer.P thing
              -> String
              -> Hsc thing
+hscParseThing = hscParseThingWithLocation "<interactive>" 1
 
-hscParseThing parser str
+hscParseThingWithLocation :: (Outputable thing)
+             => String -> Int 
+              -> Lexer.P thing
+             -> String
+             -> Hsc thing
+hscParseThingWithLocation source linenumber parser str
  = {-# SCC "Parser" #-} do
       dflags <- getDynFlags
       liftIO $ showPass dflags "Parser"
-  
+
       let buf = stringToStringBuffer str
-          loc = mkSrcLoc (fsLit "<interactive>") 1 1
+          loc  = mkSrcLoc (fsLit source) linenumber 1
 
       case unP parser (mkPState dflags buf loc) of
 
@@ -1207,6 +1228,7 @@ mkModGuts mod binds = ModGuts {
   mg_insts = [],
   mg_fam_insts = [],
   mg_rules = [],
+  mg_vect_decls = [],
   mg_binds = binds,
   mg_foreign = NoStubs,
   mg_warns = NoWarnings,