#ifdef GHCI
, hscGetModuleExports
, hscTcRnLookupRdrName
- , hscStmt, hscTcExpr, hscImport, hscKcType
+ , hscStmt, hscStmtWithLocation
+ , hscTcExpr, hscImport, hscKcType
, hscCompileCoreExpr
#endif
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,
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
-- -----------------------------------------------------------------------------
-- 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
-> 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
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
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
mg_insts = [],
mg_fam_insts = [],
mg_rules = [],
+ mg_vect_decls = [],
mg_binds = binds,
mg_foreign = NoStubs,
mg_warns = NoWarnings,