-- * Flags and settings
DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
- GhcMode(..), GhcLink(..),
+ GhcMode(..), GhcLink(..), defaultObjectTarget,
parseDynamicFlags,
getSessionDynFlags,
setSessionDynFlags,
+ parseStaticFlags,
-- * Targets
Target(..), TargetId(..), Phase,
workingDirectoryChanged,
checkModule, CheckedModule(..),
TypecheckedSource, ParsedSource, RenamedSource,
+ compileToCore,
-- * Parsing Haddock comments
parseHaddockComment,
typeKind,
parseName,
RunResult(..),
- runStmt, stepStmt, -- traceStmt,
- resume, stepResume, -- traceResume,
- Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan),
+ runStmt, SingleStep(..),
+ resume,
+ Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
+ resumeHistory, resumeHistoryIx),
+ History(historyBreakInfo), getHistorySpan,
getResumeContext,
abandon, abandonAll,
+ InteractiveEval.back,
+ InteractiveEval.forward,
showModule,
isModuleInterpreted,
compileExpr, HValue, dynCompileExpr,
-- ** Names
Name,
- nameModule, pprParenSymName, nameSrcLoc,
+ isExternalName, nameModule, pprParenSymName, nameSrcSpan,
NamedThing(..),
RdrName(Qual,Unqual),
-- ** Source locations
SrcLoc, pprDefnLoc,
- mkSrcLoc, isGoodSrcLoc,
+ mkSrcLoc, isGoodSrcLoc, noSrcLoc,
srcLocFile, srcLocLine, srcLocCol,
SrcSpan,
- mkSrcSpan, srcLocSpan,
+ mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
srcSpanStart, srcSpanEnd,
srcSpanFile,
srcSpanStartLine, srcSpanEndLine,
import OccName ( parenSymOcc )
import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
import SrcLoc
+import Desugar
+import CoreSyn
+import TcRnDriver ( tcRnModule )
import DriverPipeline
-import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
+import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
import HeaderInfo ( getImports, getOptions )
import Finder
import HscMain ( newHscEnv, hscFileCheck, HscChecked(..) )
import HscTypes
import DynFlags
+import StaticFlags
import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
cleanTempDirs )
import Module
import Control.Exception as Exception hiding (handle)
import Data.IORef
import System.IO
-import System.IO.Error ( isDoesNotExistError )
+import System.IO.Error ( try, isDoesNotExistError )
import Prelude hiding (init)
-#if __GLASGOW_HASKELL__ < 600
-import System.IO as System.IO.Error ( try )
-#else
-import System.IO.Error ( try )
-#endif
-- -----------------------------------------------------------------------------
-- Exception handlers
modifyMVar_ interruptTargetThread (return . (main_thread :))
installSignalHandlers
+ initStaticOpts
dflags0 <- initSysTools mb_top_dir defaultDynFlags
dflags <- initDynFlags dflags0
env <- newHscEnv dflags
typecheckedSource = Just tc_binds,
checkedModuleInfo = Just minf }))
--- ---------------------------------------------------------------------------
+-- | This is the way to get access to the Core bindings corresponding
+-- to a module. 'compileToCore' first invokes 'checkModule' to parse and
+-- typecheck the module, then desugars it and returns the resulting list
+-- of Core bindings if successful. It is assumed that the given filename
+-- has already been loaded.
+compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
+compileToCore session@(Session ref) fn = do
+ hsc_env <- readIORef ref
+ -- First, determine the module name.
+ modSummary <- summariseFile hsc_env [] fn Nothing Nothing
+ let mod = moduleName $ ms_mod modSummary
+ -- Next, parse and typecheck the module
+ maybeCheckedModule <- checkModule session mod
+ case maybeCheckedModule of
+ Nothing -> return Nothing
+ Just checkedMod -> do
+ let parsedMod = parsedSource checkedMod
+ -- Note: this typechecks the module twice (because checkModule
+ -- also calls tcRnModule), but arranging for checkModule to
+ -- return the type env would require changing a lot of data
+ -- structures, so I'm leaving it like that for now.
+ (_, maybe_tc_result) <- tcRnModule hsc_env HsSrcFile False parsedMod
+ -- Get the type environment from the typechecking result
+ case maybe_tc_result of
+ -- TODO: this ignores the type error messages and just returns Nothing
+ Nothing -> return Nothing
+ Just tcgEnv -> do
+ let dflags = hsc_dflags hsc_env
+ -- Finally, compile to Core and return the resulting bindings
+ maybeModGuts <- deSugar hsc_env (ms_location modSummary) tcgEnv
+ case maybeModGuts of
+ Nothing -> return Nothing
+ Just mg -> return $ Just $ mg_binds mg
+ -- ---------------------------------------------------------------------------
-- Unloading
unload :: HscEnv -> [Linkable] -> IO ()