GHC.hs 11.8 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360
--
-- (c) The University of Glasgow, 2004
--
-- The GHC API
--

module GHC (
	-- * Initialisation
	GhcSession,
	GhcMode(..),
	defaultErrorHandler,
	defaultCleanupHandler,
	init,
	newSession,

	-- * Flags and settings
	DynFlags(..),
	DynFlag(..),
	getSessionDynFlags,
	setSessionDynFlags,
	setMsgHandler,
  ) where

import HscTypes		( GhcMode(..) )
import qualified ErrUtils

-- -----------------------------------------------------------------------------
-- Initialisation

-- | abstract type representing a session with GHC.  A session
-- includes the currently loaded modules, and any bindings made using
-- interactive evaluation.
data Session = 
  Session {
	sess_hscenv :: IORef HscEnv  -- will include the InteractiveContext
  }

-- | Install some default exception handlers and run the inner computation.
-- Unless you want to handle exceptions yourself, you should wrap this around
-- the top level of your program.  The default handlers output the error
-- message(s) to stderr and exit cleanly.
defaultErrorHandler :: IO a -> IO a
defaultErrorHandler inner = 
  -- top-level exception handler: any unrecognised exception is a compiler bug.
  handle (\exception -> do
  	   hFlush stdout
	   case exception of
		-- an IO exception probably isn't our fault, so don't panic
		IOException _ ->  hPutStrLn stderr (show exception)
		AsyncException StackOverflow ->
			hPutStrLn stderr "stack overflow: use +RTS -K<size> to increase it"
		_other ->  hPutStr stderr (show (Panic (show exception)))
	   exitWith (ExitFailure 1)
         ) $

  -- all error messages are propagated as exceptions
  handleDyn (\dyn -> do
  		hFlush stdout
  		case dyn of
		     PhaseFailed _ code -> exitWith code
		     Interrupted -> exitWith (ExitFailure 1)
		     _ -> do hPutStrLn stderr (show (dyn :: GhcException))
			     exitWith (ExitFailure 1)
	    ) $
  inner

-- | Install a default cleanup handler to remove temporary files
-- deposited by a GHC run.  This is seperate from
-- 'defaultErrorHandler', because you might want to override the error
-- handling, but still get the ordinary cleanup behaviour.
defaultCleanupHandler :: IO a -> IO a
defaultCleanupHandler inner = 
   -- make sure we clean up after ourselves
   later (do  forget_it <- readIORef v_Keep_tmp_files
	      unless forget_it $ do
	      verb <- dynFlag verbosity
	      cleanTempFiles verb
     ) $
	-- exceptions will be blocked while we clean the temporary files,
	-- so there shouldn't be any difficulty if we receive further
	-- signals.
   inner


-- | Initialises GHC.  This must be done /once/ only.  Takes the
-- command-line arguments.  All command-line arguments beginning with
-- '-' are interpreted as flags.  All others are returned.
--
init :: [String] -> IO [String]
init args = do
   -- catch ^C
   installSignalHandlers

   argv <- getArgs
   let (minusB_args, argv') = partition (prefixMatch "-B") argv
   top_dir <- initSysTools minusB_args

	-- Process all the other arguments, and get the source files
   non_static <- processArgs static_flags argv' []
   mode <- readIORef v_CmdLineMode

	-- Read all package.conf files (system, user, -package-conf)
   readPackageConfigs

	-- load explicit packages (those named with -package on the cmdline)
   loadExplicitPackages

	-- -O and --interactive are not a good combination
	-- ditto with any kind of way selection
   orig_ways <- readIORef v_Ways
   when (notNull orig_ways && isInteractive mode) $
      do throwDyn (UsageError 
                   "--interactive can't be used with -prof, -ticky, -unreg or -smp.")

	-- Find the build tag, and re-process the build-specific options.
	-- Also add in flags for unregisterised compilation, if 
	-- GhcUnregisterised=YES.
   way_opts <- findBuildTag
   let unreg_opts | cGhcUnregisterised == "YES" = unregFlags
		  | otherwise = []
   pkg_extra_opts <- getPackageExtraGhcOpts
   extra_non_static <- processArgs static_flags 
			   (unreg_opts ++ way_opts ++ pkg_extra_opts) []

	-- Give the static flags to hsc
   static_opts <- buildStaticHscOpts
   writeIORef v_Static_hsc_opts static_opts

   -- build the default DynFlags (these may be adjusted on a per
   -- module basis by OPTIONS pragmas and settings in the interpreter).

   stg_todo  <- buildStgToDo

   -- set the "global" HscLang.  The HscLang can be further adjusted on a module
   -- by module basis, using only the -fvia-C and -fasm flags.  If the global
   -- HscLang is not HscC or HscAsm, -fvia-C and -fasm have no effect.
   dyn_flags <- getDynFlags
   let lang = case mode of 
		 DoInteractive  -> HscInterpreted
		 DoEval _	-> HscInterpreted
		 _other		-> hscLang dyn_flags

   setDynFlags (dyn_flags{ stgToDo  = stg_todo,
                  	   hscLang  = lang,
			   -- leave out hscOutName for now
	                   hscOutName = panic "Main.main:hscOutName not set",
		  	   verbosity = case mode of
				 	 DoEval _ -> 0
				 	 _other   -> 1
			})

	-- The rest of the arguments are "dynamic"
	-- Leftover ones are presumably files
   fileish_args <- processArgs dynamic_flags (extra_non_static ++ non_static) []

	-- save the "initial DynFlags" away
   saveDynFlags

	-- and return the leftover args
   return fileish_args


-- | Starts a new session.  A session consists of a set of loaded
-- modules, a set of options (DynFlags), and an interactive context.
-- ToDo: GhcMode should say "keep typechecked code" and/or "keep renamed
-- code".
newSession :: GhcMode -> IO Session
newSession mode = do
  dflags <- getDynFlags
  env <- newHscEnv mode dflags
  ref <- newIORef env
  panic "do we need to set v_CmdLineMode? finder uses it."
  return (Session {sess_hscenv = ref})

-- -----------------------------------------------------------------------------
-- Flags & settings

-- | Grabs the DynFlags from the Session
getSessionDynFlags :: Session -> IO DynFlags
getSessionDynFlags sess = do
  env <- readIORef (sess_hscenv sess)
  return (hsc_dflags env)

-- | Updates the DynFlags in a Session
updateSessionDynFlags :: Session -> DynFlags -> IO ()
updateSessionDynFlags sess dflags = do
  env <- readIORef (sess_hscenv sess)
  writeIORef (sess_hscenv sess) env{hsc_dflags=dflags}

-- | Messages during compilation (eg. warnings and progress messages)
-- are reported using this callback.  By default, these messages are
-- printed to stderr.
setMsgHandler :: (String -> IO ()) -> IO ()
setMsgHandler = ErrUtils.setMsgHandler

-- -----------------------------------------------------------------------------
-- Loading a program

-- | A compilation target.
data Target = Target TargetId (Maybe StringBuffer)
	-- A target may be supplied with the actual text of the
	-- module.  If so, use this instead of the file contents (this
	-- is for use in an IDE where the file hasn't been saved by
	-- the user yet).

data TargetId
  = TargetModule String		-- A module name: search for the file
  | TargetFile   FilePath 	-- A filename: parse it to find the module name.

-- ToDo: think about relative vs. absolute file paths. And what
-- happens when the current directory changes.

-- | Sets the targets for this session.  Each target may be a module name
-- or a filename.  The targets correspond to the set of root modules for
-- the program/library.  Unloading the current program is achieved by
-- setting the current set of targets to be empty.
setTargets :: Session -> [Target] -> IO ()

-- | returns the current set of targets
--getTargets :: Session -> IO [Target]

-- Add another target, or update an existing target with new content.
addTarget :: Session -> Target -> IO Module

-- Remove a target
removeTarget :: Session -> Module -> IO ()

-- Try to load the program.  If a Module is supplied, then just
-- attempt to load up to this target.  If no Module is supplied,
-- then try to load all targets.
load :: Session -> Maybe Module -> IO LoadResult

-- | The result of load.
data LoadResult
  = LoadOk	Errors	-- ^ all specified targets were loaded successfully.
  | LoadFailed  Errors	-- ^ not all modules were loaded.

type Errors = [ErrMsg]

data ErrMsg = ErrMsg { 
	errMsgSeverity  :: Severity,  -- warning, error, etc.
	errMsgSpans     :: [SrcSpan],
	errMsgShortDoc  :: Doc,
	errMsgExtraInfo :: Doc
	}

-- -----------------------------------------------------------------------------
-- inspecting the session

-- | Get the set of modules in the current session
getLoadedModules :: Session -> IO [Module]

-- | Get the module dependency graph
getModuleGraph :: Session -> IO (DiGraph ModSummary)

getModuleInfo :: Session -> Module -> IO ModuleInfo

data ObjectCode
  = ByteCode
  | BinaryCode FilePath

data ModuleInfo = ModuleInfo {
  lm_modulename :: Module,
  lm_summary    :: ModSummary,
  lm_interface  :: ModIface,
  lm_tc_code    :: Maybe TypecheckedCode,
  lm_rn_code    :: Maybe RenamedCode,
  lm_obj        :: Maybe ObjectCode
  }

type TypecheckedCode = HsTypecheckedGroup
type RenamedCode     = [HsGroup Name]

-- ToDo: typechecks abstract syntax or renamed abstract syntax.  Issues:
--   - typechecked syntax includes extra dictionary translation and
--     AbsBinds which need to be translated back into something closer to
--     the original source.
--   - renamed syntax currently doesn't exist in a single blob, since
--     renaming and typechecking are interleaved at splice points.  We'd
--     need a restriction that there are no splices in the source module.

-- ToDo:
--   - Data and Typeable instances for HsSyn.

-- ToDo:
--   - things that aren't in the output of the renamer:
--     - the export list
--     - the imports

-- ToDo:
--   - things that aren't in the output of the typechecker right now:
--     - the export list
--     - the imports
--     - type signatures
--     - type/data/newtype declarations
--     - class declarations
--     - instances
--   - extra things in the typechecker's output:
--     - default methods are turned into top-level decls.
--     - dictionary bindings

-- ToDo: check for small transformations that happen to the syntax in
-- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)

-- ToDo: maybe use TH syntax instead of IfaceSyn?  There's already a way
-- to get from TyCons, Ids etc. to TH syntax (reify).

-- :browse will use either lm_toplev or inspect lm_interface, depending
-- on whether the module is interpreted or not.

-- various abstract syntax types (perhaps IfaceBlah)
data Type = ...
data Kind = ...

-- This is for reconstructing refactored source code
-- Calls the lexer repeatedly.
-- ToDo: add comment tokens to token stream
getTokenStream :: Session -> Module -> IO [Located Token]

-- -----------------------------------------------------------------------------
-- Interactive evaluation

-- | Set the interactive evaluation context.
--
-- Setting the context doesn't throw away any bindings; the bindings
-- we've built up in the InteractiveContext simply move to the new
-- module.  They always shadow anything in scope in the current context.
setContext :: Session
	   -> [Module]	-- entire top level scope of these modules
	   -> [Module]	-- exports only of these modules
	   -> IO ()

-- | Get the interactive evaluation context.
getContext :: Session -> IO ([Module],[Module])

-- | Looks up an identifier in the current interactive context (for :info)
lookupThing :: Session -> String -> IO [TyThing]

-- | Looks up a Name in the current interactive context (for inspecting
-- the result names from 'runStmt').
lookupName :: Session -> Name -> IO TyThing

-- | Get the type of an expression
exprType :: Session -> String -> IO (Either Errors Type)

-- | Get the kind of a  type
typeKind  :: Session -> String -> IO (Either Errors Kind)

data RunResult
  = RunOk [Name] 		-- ^ names bound by this evaluation
  | RunFailed Errors 		-- ^ statement failed compilation
  | RunException Exception	-- ^ statement raised an exception

-- | Run a statement in the current interactive context.  Statemenet
-- may bind multple values.
runStmt :: Session -> String -> IO RunResult

-- | Return a list of the transient bindings in the current interactive
-- context (i.e. those bindings made via runStmt).
getInteractiveBindings :: Session -> IO [TyThing]