[project @ 2005-06-16 09:33:41 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / GHC.hs
index 65a295e..dd86581 100644 (file)
@@ -56,19 +56,21 @@ module GHC (
        modInfoLookupName,
        lookupGlobalName,
 
+       -- * Printing
+       PrintUnqualified, alwaysQualify,
+
        -- * Interactive evaluation
        getBindings, getPrintUnqual,
 #ifdef GHCI
        setContext, getContext, 
        getNamesInScope,
        moduleIsInterpreted,
-       getInfo, GetInfoResult,
+       getInfo,
        exprType,
        typeKind,
        parseName,
        RunResult(..),
        runStmt,
-       browseModule,
        showModule,
        compileExpr, HValue,
        lookupName,
@@ -80,34 +82,47 @@ module GHC (
        Module, mkModule, pprModule,
 
        -- ** Names
-       Name, nameModule,
+       Name, 
+       nameModule, nameParent_maybe, pprParenSymName, nameSrcLoc,
+       NamedThing(..),
        
        -- ** Identifiers
        Id, idType,
        isImplicitId, isDeadBinder,
        isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
        isRecordSelector,
-       isPrimOpId, isFCallId,
+       isPrimOpId, isFCallId, isClassOpId_maybe,
        isDataConWorkId, idDataCon,
        isBottomingId, isDictonaryId,
+       recordSelectorFieldLabel,
 
        -- ** Type constructors
        TyCon, 
+       tyConTyVars, tyConDataCons,
        isClassTyCon, isSynTyCon, isNewTyCon,
+       getSynTyConDefn,
 
        -- ** Data constructors
        DataCon,
+       dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
+       dataConIsInfix, isVanillaDataCon,
+       dataConStrictMarks,  
+       StrictnessMark(..), isMarkedStrict,
 
        -- ** Classes
        Class, 
-       classSCTheta, classTvsFds,
+       classMethods, classSCTheta, classTvsFds,
+       pprFundeps,
 
        -- ** Instances
-       Instance,
+       Instance, 
+       instanceDFunId, pprInstance,
 
        -- ** Types and Kinds
-       Type, dropForAlls,
+       Type, dropForAlls, splitForAllTys, funResultTy, pprParendType,
        Kind,
+       PredType,
+       ThetaType, pprThetaArrow,
 
        -- ** Entities
        TyThing(..), 
@@ -115,6 +130,15 @@ module GHC (
        -- ** Syntax
        module HsSyn, -- ToDo: remove extraneous bits
 
+       -- ** Fixities
+       FixityDirection(..), 
+       defaultFixity, maxPrecedence, 
+       negateFixity,
+       compareFixity,
+
+       -- ** Source locations
+       SrcLoc, pprDefnLoc,
+
        -- * Exceptions
        GhcException(..), showGhcException,
 
@@ -126,8 +150,7 @@ module GHC (
 {-
  ToDo:
 
-  * inline bits of HscMain here to simplify layering: hscGetInfo,
-    hscTcExpr, hscStmt.
+  * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
   * we need to expose DynFlags, so should parseDynamicFlags really be
     part of this interface?
   * what StaticFlags should we expose, if any?
@@ -138,17 +161,15 @@ module GHC (
 #ifdef GHCI
 import qualified Linker
 import Linker          ( HValue, extendLinkEnv )
-import TcRnDriver      ( getModuleContents, tcRnLookupRdrName,
-                         getModuleExports )
+import TcRnDriver      ( tcRnLookupRdrName, tcRnGetInfo,
+                         tcRnLookupName, getModuleExports )
 import RdrName         ( plusGlobalRdrEnv, Provenance(..), 
                          ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
                          emptyGlobalRdrEnv, mkGlobalRdrEnv )
-import HscMain         ( hscGetInfo, GetInfoResult, hscParseIdentifier,
-                         hscStmt, hscTcExpr, hscKcType )
+import HscMain         ( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
 import Type            ( tidyType )
 import VarEnv          ( emptyTidyEnv )
 import GHC.Exts                ( unsafeCoerce# )
-import IfaceSyn                ( IfaceDecl )
 #endif
 
 import Packages                ( initPackages, isHomeModule )
@@ -156,19 +177,27 @@ import NameSet            ( NameSet, nameSetToList, elemNameSet )
 import RdrName         ( GlobalRdrEnv, GlobalRdrElt(..), RdrName, 
                          globalRdrEnvElts )
 import HsSyn
-import Type            ( Kind, Type, dropForAlls )
+import Type            ( Kind, Type, dropForAlls, PredType, ThetaType,
+                         pprThetaArrow, pprParendType, splitForAllTys,
+                         funResultTy )
 import Id              ( Id, idType, isImplicitId, isDeadBinder,
                           isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
-                          isRecordSelector,
-                          isPrimOpId, isFCallId,
+                          isRecordSelector, recordSelectorFieldLabel,
+                          isPrimOpId, isFCallId, isClassOpId_maybe,
                           isDataConWorkId, idDataCon,
                           isBottomingId )
-import TyCon           ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon )
-import Class           ( Class, classSCTheta, classTvsFds )
-import DataCon         ( DataCon )
-import Name            ( Name, nameModule )
+import TyCon           ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
+                         tyConTyVars, tyConDataCons, getSynTyConDefn )
+import Class           ( Class, classSCTheta, classTvsFds, classMethods )
+import FunDeps         ( pprFundeps )
+import DataCon         ( DataCon, dataConWrapId, dataConSig, dataConTyCon,
+                         dataConFieldLabels, dataConStrictMarks, 
+                         dataConIsInfix, isVanillaDataCon )
+import Name            ( Name, nameModule, NamedThing(..), nameParent_maybe,
+                         nameSrcLoc )
+import OccName         ( parenSymOcc )
 import NameEnv         ( nameEnvElts )
-import InstEnv         ( Instance )
+import InstEnv         ( Instance, instanceDFunId, pprInstance )
 import SrcLoc
 import DriverPipeline
 import DriverPhases    ( Phase(..), isHaskellSrcFilename, startPhase )
@@ -192,7 +221,7 @@ import Util
 import StringBuffer    ( StringBuffer, hGetStringBuffer )
 import Outputable
 import SysTools                ( cleanTempFilesExcept )
-import BasicTypes      ( SuccessFlag(..), succeeded, failed )
+import BasicTypes
 import TcType           ( tcSplitSigmaTy, isDictTy )
 import FastString      ( mkFastString )
 
@@ -401,7 +430,11 @@ depanal (Session ref) excluded_mods = do
                     text "Chasing modules from: ",
                        hcat (punctuate comma (map pprTarget targets))]))
 
-  downsweep hsc_env old_graph excluded_mods
+  r <- downsweep hsc_env old_graph excluded_mods
+  case r of
+    Right mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
+    _ -> return ()
+  return r
 
 {-
 -- | The result of load.
@@ -442,11 +475,8 @@ loadMsgs s@(Session ref) how_much msg_act
        -- were successfully loaded by inspecting the Session's HPT.
        mb_graph <- depanal s []
        case mb_graph of
-          Left msgs -> do msg_act msgs; return Failed
-          Right mod_graph -> do
-               hsc_env <- readIORef ref
-               writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
-               loadMsgs2 s how_much msg_act mod_graph 
+          Left msgs       -> do msg_act msgs; return Failed
+          Right mod_graph -> loadMsgs2 s how_much msg_act mod_graph 
 
 loadMsgs2 s@(Session ref) how_much msg_act mod_graph = do
        hsc_env <- readIORef ref
@@ -454,15 +484,16 @@ loadMsgs2 s@(Session ref) how_much msg_act mod_graph = do
         let hpt1      = hsc_HPT hsc_env
         let dflags    = hsc_dflags hsc_env
         let ghci_mode = ghcMode dflags -- this never changes
-        let verb      = verbosity dflags
 
        -- The "bad" boot modules are the ones for which we have
        -- B.hs-boot in the module graph, but no B.hs
        -- The downsweep should have ensured this does not happen
        -- (see msDeps)
         let all_home_mods = [ms_mod s | s <- mod_graph, not (isBootSummary s)]
+#ifdef DEBUG
            bad_boot_mods = [s        | s <- mod_graph, isBootSummary s,
                                        not (ms_mod s `elem` all_home_mods)]
+#endif
        ASSERT( null bad_boot_mods ) return ()
 
         -- mg2_with_srcimps drops the hi-boot nodes, returning a 
@@ -672,6 +703,22 @@ type ParsedSource      = Located (HsModule RdrName)
 type RenamedSource     = HsGroup Name
 type TypecheckedSource = LHsBinds Id
 
+-- NOTE:
+--   - things that aren't in the output of the renamer:
+--     - the export list
+--     - the imports
+--   - 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
+
+
 -- | This is the way to get access to parsed and typechecked source code
 -- for a module.  'checkModule' loads all the dependencies of the specified
 -- module in the Session, and then attempts to typecheck the module.  If
@@ -726,6 +773,8 @@ checkModule session@(Session ref) mod msg_act = do
                                        renamedSource = renamed,
                                        typecheckedSource = Just tc_binds,
                                        checkedModuleInfo = Just minf }))
+               _other ->
+                       panic "checkModule"
 
 -- ---------------------------------------------------------------------------
 -- Unloading
@@ -832,9 +881,9 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
          | otherwise = False
          where
             same_as_prev t = case lookupModuleEnv hpt (ms_mod ms) of
-                               Nothing  -> True
                                Just hmi  | Just l <- hm_linkable hmi
                                 -> isObjectLinkable l && t == linkableTime l
+                               _other  -> True
                -- why '>=' rather than '>' above?  If the filesystem stores
                -- times to the nearset second, we may occasionally find that
                -- the object & source have the same modification time, 
@@ -844,10 +893,10 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
 
        bco_ok ms
          = case lookupModuleEnv hpt (ms_mod ms) of
-               Nothing  -> False
                Just hmi  | Just l <- hm_linkable hmi ->
                        not (isObjectLinkable l) && 
                        linkableTime l >= ms_hs_date ms
+               _other  -> False
 
 ms_allimps :: ModSummary -> [Module]
 ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
@@ -1175,35 +1224,12 @@ type NodeMap a = FiniteMap NodeKey a      -- keyed by (mod, src_file_type) pairs
 msKey :: ModSummary -> NodeKey
 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (mod,boot)
 
-emptyNodeMap :: NodeMap a
-emptyNodeMap = emptyFM
-
 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
        
 nodeMapElts :: NodeMap a -> [a]
 nodeMapElts = eltsFM
 
--- -----------------------------------------------------------------
--- The unlinked image
--- 
--- The compilation manager keeps a list of compiled, but as-yet unlinked
--- binaries (byte code or object code).  Even when it links bytecode
--- it keeps the unlinked version so it can re-link it later without
--- recompiling.
-
-type UnlinkedImage = [Linkable]        -- the unlinked images (should be a set, really)
-
-findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
-findModuleLinkable_maybe lis mod
-   = case [LM time nm us | LM time nm us <- lis, nm == mod] of
-        []   -> Nothing
-        [li] -> Just li
-        many -> pprPanic "findModuleLinkable" (ppr mod)
-
-delModuleLinkable :: [Linkable] -> Module -> [Linkable]
-delModuleLinkable ls mod = [ l | l@(LM _ nm _) <- ls, nm /= mod ]
-
 -----------------------------------------------------------------------------
 -- Downsweep (dependency analysis)
 
@@ -1672,36 +1698,22 @@ lookupGlobalName s name = withSession s $ \hsc_env -> do
    eps <- readIORef (hsc_EPS hsc_env)
    return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
 
-#if 0
+-- -----------------------------------------------------------------------------
+-- Misc exported utils
 
-data ObjectCode
-  = ByteCode
-  | BinaryCode FilePath
+dataConType :: DataCon -> Type
+dataConType dc = idType (dataConWrapId dc)
 
--- 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.
+-- | print a 'NamedThing', adding parentheses if the name is an operator.
+pprParenSymName :: NamedThing a => a -> SDoc
+pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
 
--- ToDo:
---   - Data and Typeable instances for HsSyn.
+-- ----------------------------------------------------------------------------
 
--- ToDo:
---   - things that aren't in the output of the renamer:
---     - the export list
---     - the imports
+#if 0
 
 -- 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
+--   - Data and Typeable instances for HsSyn.
 
 -- ToDo: check for small transformations that happen to the syntax in
 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
@@ -1810,9 +1822,8 @@ moduleIsInterpreted s modl = withSession s $ \h ->
       _not_a_home_module -> return False
 
 -- | Looks up an identifier in the current interactive context (for :info)
-{-# DEPRECATED getInfo "we should be using parseName/lookupName instead" #-}
-getInfo :: Session -> String -> IO [GetInfoResult]
-getInfo s id = withSession s $ \hsc_env -> hscGetInfo hsc_env id
+getInfo :: Session -> Name -> IO (Maybe (TyThing,Fixity,[Instance]))
+getInfo s name = withSession s $ \hsc_env -> tcRnGetInfo hsc_env name
 
 -- | Returns all names in scope in the current interactive context
 getNamesInScope :: Session -> IO [Name]
@@ -1836,12 +1847,7 @@ parseName s str = withSession s $ \hsc_env -> do
 -- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
 -- entity known to GHC, including 'Name's defined using 'runStmt'.
 lookupName :: Session -> Name -> IO (Maybe TyThing)
-lookupName s name = withSession s $ \hsc_env -> do
-  case lookupTypeEnv (ic_type_env (hsc_IC hsc_env)) name of
-       Just tt -> return (Just tt)
-       Nothing -> do
-           eps <- readIORef (hsc_EPS hsc_env)
-           return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
+lookupName s name = withSession s $ \hsc_env -> tcRnLookupName hsc_env name
 
 -- -----------------------------------------------------------------------------
 -- Getting the type of an expression
@@ -1855,7 +1861,6 @@ exprType s expr = withSession s $ \hsc_env -> do
        Just ty -> return (Just tidy_ty)
             where 
                tidy_ty = tidyType emptyTidyEnv ty
-               dflags  = hsc_dflags hsc_env
 
 -- -----------------------------------------------------------------------------
 -- Getting the kind of a type
@@ -1965,18 +1970,6 @@ foreign import "rts_evalStableIO"  {- safe -}
   -- more informative than the C type!
 -}
 
--- ---------------------------------------------------------------------------
--- cmBrowseModule: get all the TyThings defined in a module
-
-{-# DEPRECATED browseModule "we should be using getModuleInfo instead" #-}
-browseModule :: Session -> Module -> Bool -> IO [IfaceDecl]
-browseModule s modl exports_only = withSession s $ \hsc_env -> do
-  mb_decls <- getModuleContents hsc_env modl exports_only
-  case mb_decls of
-       Nothing -> return []            -- An error of some kind
-       Just ds -> return ds
-
-
 -----------------------------------------------------------------------------
 -- show a module and it's source/object filenames