Merge remote branch 'origin/master' into ghc-new-co
[ghc-hetmet.git] / compiler / main / HscTypes.lhs
index 33b4448..4d096d2 100644 (file)
@@ -14,7 +14,7 @@ module HscTypes (
 
         -- * Information about modules
        ModDetails(..), emptyModDetails,
-       ModGuts(..), CgGuts(..), ForeignStubs(..),
+        ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
         ImportedMods,
 
        ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
@@ -25,8 +25,9 @@ module HscTypes (
        
        -- * State relating to modules in this package
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
-       hptInstances, hptRules, hptVectInfo,
-       
+        hptInstances, hptRules, hptVectInfo,
+        hptObjs,
+
        -- * State relating to known packages
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
@@ -53,13 +54,13 @@ module HscTypes (
 
         -- * TyThings and type environments
        TyThing(..),
-       tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
+       tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId, tyThingCoAxiom,
        implicitTyThings, isImplicitTyThing,
        
        TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
        extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
        typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
-       typeEnvDataCons,
+       typeEnvDataCons, typeEnvCoAxioms,
 
         -- * MonadThings
         MonadThings(..),
@@ -76,7 +77,7 @@ module HscTypes (
        Warnings(..), WarningTxt(..), plusWarns,
 
        -- * Linker stuff
-       Linkable(..), isObjectLinkable,
+        Linkable(..), isObjectLinkable, linkableObjs,
        Unlinked(..), CompiledByteCode,
        isObject, nameOfObject, isInterpretable, byteCodeOfObject,
         
@@ -130,7 +131,7 @@ import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
 import BasicTypes      ( IPName, defaultFixity, WarningTxt(..) )
 import OptimizationFuel        ( OptFuelState )
 import IfaceSyn
-import CoreSyn         ( CoreRule )
+import CoreSyn         ( CoreRule, CoreVect )
 import Maybes          ( orElse, expectJust, catMaybes )
 import Outputable
 import BreakArray
@@ -494,6 +495,9 @@ hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
 
        -- And get its dfuns
     , thing <- things ]
+
+hptObjs :: HomePackageTable -> [FilePath]
+hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsUFM hpt))
 \end{code}
 
 %************************************************************************
@@ -547,14 +551,22 @@ data FindResult
        -- ^ The requested package was not found
   | FoundMultiple [PackageId]
        -- ^ _Error_: both in multiple packages
-  | NotFound [FilePath] (Maybe PackageId) [PackageId] [PackageId]
-       -- ^ The module was not found, including either
-        --    * the specified places were searched
-        --    * the package that this module should have been in
-        --    * list of packages in which the module was hidden,
-        --    * list of hidden packages containing this module
-  | NotFoundInPackage PackageId
-       -- ^ The module was not found in this package
+
+  | NotFound          -- Not found
+      { fr_paths       :: [FilePath]       -- Places where I looked
+
+      , fr_pkg         :: Maybe PackageId  -- Just p => module is in this package's
+                                           --           manifest, but couldn't find
+                                           --           the .hi file
+
+      , fr_mods_hidden :: [PackageId]      -- Module is in these packages,
+                                           --   but the *module* is hidden
+
+      , fr_pkgs_hidden :: [PackageId]      -- Module is in these packages,
+                                           --   but the *package* is hidden
+
+      , fr_suggestions :: [Module]         -- Possible mis-spelled modules
+      }
 
 -- | Cache that remembers where we found a particular module.  Contains both
 -- home modules and package modules.  On @:load@, only home modules are
@@ -705,7 +717,7 @@ type ImportedMods = ModuleEnv [(ModuleName, Bool, SrcSpan)]
 -- | A ModGuts is carried through the compiler, accumulating stuff as it goes
 -- There is only one ModGuts at any time, the one for the module
 -- being compiled right now.  Once it is compiled, a 'ModIface' and 
--- 'ModDetails' are extracted and the ModGuts is dicarded.
+-- 'ModDetails' are extracted and the ModGuts is discarded.
 data ModGuts
   = ModGuts {
         mg_module    :: !Module,         -- ^ Module being compiled
@@ -730,9 +742,11 @@ data ModGuts
        mg_binds     :: ![CoreBind],     -- ^ Bindings for this module
        mg_foreign   :: !ForeignStubs,   -- ^ Foreign exports declared in this module
        mg_warns     :: !Warnings,       -- ^ Warnings declared in the module
-       mg_anns      :: [Annotation],    -- ^ Annotations declared in this module
-       mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module
+        mg_anns      :: [Annotation],    -- ^ Annotations declared in this module
+        mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module
         mg_modBreaks :: !ModBreaks,      -- ^ Breakpoints for the module
+        mg_vect_decls:: ![CoreVect],     -- ^ Vectorisation declarations in this module
+                                         --   (produced by desugarer & consumed by vectoriser)
         mg_vect_info :: !VectInfo,       -- ^ Pool of vectorised declarations in the module
 
        -- The next two fields are unusual, because they give instance
@@ -785,11 +799,7 @@ data CgGuts
                -- data constructor workers; reason: we we regard them
                -- as part of the code-gen of tycons
 
-       cg_dir_imps :: ![Module],
-               -- ^ Directly-imported modules; used to generate
-               -- initialisation code
-
-       cg_foreign  :: !ForeignStubs,   -- ^ Foreign export stubs
+        cg_foreign  :: !ForeignStubs,   -- ^ Foreign export stubs
        cg_dep_pkgs :: ![PackageId],    -- ^ Dependent packages, used to 
                                        -- generate #includes for C code gen
         cg_hpc_info :: !HpcInfo,        -- ^ Program coverage tick box information
@@ -809,6 +819,10 @@ data ForeignStubs = NoStubs             -- ^ We don't have any stubs
                    --
                    --  2) C stubs to use when calling
                    --     "foreign exported" functions
+
+appendStubC :: ForeignStubs -> SDoc -> ForeignStubs
+appendStubC NoStubs            c_code = ForeignStubs empty c_code
+appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
 \end{code}
 
 \begin{code}
@@ -852,17 +866,21 @@ emptyModIface mod
 -- | Interactive context, recording information relevant to GHCi
 data InteractiveContext 
   = InteractiveContext { 
-       ic_toplev_scope :: [Module],    -- ^ The context includes the "top-level" scope of
+          ic_toplev_scope :: [Module]   -- ^ The context includes the "top-level" scope of
                                        -- these modules
 
-       ic_exports :: [(Module, Maybe (ImportDecl RdrName))],           -- ^ The context includes just the exported parts of these
+        , ic_exports :: [(Module, Maybe (ImportDecl RdrName))]    -- ^ The context includes just the exported parts of these
                                        -- modules
 
-       ic_rn_gbl_env :: GlobalRdrEnv,  -- ^ The contexts' cached 'GlobalRdrEnv', built from
+        , ic_rn_gbl_env :: GlobalRdrEnv -- ^ The contexts' cached 'GlobalRdrEnv', built from
                                        -- 'ic_toplev_scope' and 'ic_exports'
 
-       ic_tmp_ids :: [Id]              -- ^ Names bound during interaction with the user.
-                                        -- Later Ids shadow earlier ones with the same OccName.
+        , ic_tmp_ids :: [Id]   -- ^ Names bound during interaction with the user.
+                               -- Later Ids shadow earlier ones with the same OccName
+                               -- Expressions are typed with these Ids in the envt
+                               -- For runtime-debugging, these Ids may have free
+                               -- TcTyVars of RuntimUnkSkol flavour, but no free TyVars
+                               -- (because the typechecker doesn't expect that)
 
 #ifdef GHCI
         , ic_resume :: [Resume]         -- ^ The stack of breakpoint contexts
@@ -1019,7 +1037,10 @@ implicitTyThings (ATyCon tc)
       -- for each data constructor in order,
       --   the contructor, worker, and (possibly) wrapper
     concatMap (extras_plus . ADataCon) (tyConDataCons tc)
-                    
+
+implicitTyThings (ACoAxiom _cc)
+  = []
+            
 implicitTyThings (AClass cl) 
   = -- dictionary datatype:
     --    [extras_plus:]
@@ -1051,10 +1072,10 @@ extras_plus thing = thing : implicitTyThings thing
 -- add the implicit coercion tycon
 implicitCoTyCon :: TyCon -> [TyThing]
 implicitCoTyCon tc 
-  = map ATyCon . catMaybes $ [-- Just if newtype, Nothing if not
-                              newTyConCo_maybe tc, 
+  = map ACoAxiom . catMaybes $ [-- Just if newtype, Nothing if not
+                              newTyConCo_maybe tc,
                               -- Just if family instance, Nothing if not
-                               tyConFamilyCoercion_maybe tc] 
+                             tyConFamilyCoercion_maybe tc] 
 
 -- sortByOcc = sortBy (\ x -> \ y -> getOccName x < getOccName y)
 
@@ -1064,10 +1085,11 @@ implicitCoTyCon tc
 -- of some other declaration, or it is generated implicitly by some
 -- other declaration.
 isImplicitTyThing :: TyThing -> Bool
-isImplicitTyThing (ADataCon _)  = True
-isImplicitTyThing (AnId     id) = isImplicitId id
-isImplicitTyThing (AClass   _)  = False
-isImplicitTyThing (ATyCon   tc) = isImplicitTyCon tc
+isImplicitTyThing (ADataCon {}) = True
+isImplicitTyThing (AnId id)     = isImplicitId id
+isImplicitTyThing (AClass {})   = False
+isImplicitTyThing (ATyCon tc)   = isImplicitTyCon tc
+isImplicitTyThing (ACoAxiom {}) = True
 
 extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
 extendTypeEnvWithIds env ids
@@ -1089,6 +1111,7 @@ emptyTypeEnv    :: TypeEnv
 typeEnvElts     :: TypeEnv -> [TyThing]
 typeEnvClasses  :: TypeEnv -> [Class]
 typeEnvTyCons   :: TypeEnv -> [TyCon]
+typeEnvCoAxioms :: TypeEnv -> [CoAxiom]
 typeEnvIds      :: TypeEnv -> [Id]
 typeEnvDataCons :: TypeEnv -> [DataCon]
 lookupTypeEnv   :: TypeEnv -> Name -> Maybe TyThing
@@ -1097,6 +1120,7 @@ emptyTypeEnv          = emptyNameEnv
 typeEnvElts     env = nameEnvElts env
 typeEnvClasses  env = [cl | AClass cl   <- typeEnvElts env]
 typeEnvTyCons   env = [tc | ATyCon tc   <- typeEnvElts env] 
+typeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env] 
 typeEnvIds      env = [id | AnId id     <- typeEnvElts env] 
 typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env] 
 
@@ -1152,6 +1176,11 @@ tyThingTyCon :: TyThing -> TyCon
 tyThingTyCon (ATyCon tc) = tc
 tyThingTyCon other      = pprPanic "tyThingTyCon" (pprTyThing other)
 
+-- | Get the 'CoAxiom' from a 'TyThing' if it is a coercion axiom thing. Panics otherwise
+tyThingCoAxiom :: TyThing -> CoAxiom
+tyThingCoAxiom (ACoAxiom ax) = ax
+tyThingCoAxiom other        = pprPanic "tyThingCoAxiom" (pprTyThing other)
+
 -- | Get the 'Class' from a 'TyThing' if it is a class thing. Panics otherwise
 tyThingClass :: TyThing -> Class
 tyThingClass (AClass cls) = cls
@@ -1776,6 +1805,9 @@ isObjectLinkable l = not (null unlinked) && all isObject unlinked
        -- compiling a module in HscNothing mode, and this choice
        -- happens to work well with checkStability in module GHC.
 
+linkableObjs :: Linkable -> [FilePath]
+linkableObjs l = [ f | DotO f <- linkableUnlinked l ]
+
 instance Outputable Linkable where
    ppr (LM when_made mod unlinkeds)
       = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
@@ -1850,13 +1882,16 @@ data ModBreaks
         -- ^ An array giving the source span of each breakpoint.
    , modBreaks_vars :: !(Array BreakIndex [OccName])
         -- ^ An array giving the names of the free variables at each breakpoint.
+   , modBreaks_decls :: !(Array BreakIndex [String])
+        -- ^ An array giving the names of the declarations enclosing each breakpoint.
    }
 
 emptyModBreaks :: ModBreaks
 emptyModBreaks = ModBreaks
    { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
          -- Todo: can we avoid this? 
-   , modBreaks_locs = array (0,-1) []
-   , modBreaks_vars = array (0,-1) []
+   , modBreaks_locs  = array (0,-1) []
+   , modBreaks_vars  = array (0,-1) []
+   , modBreaks_decls = array (0,-1) []
    }
 \end{code}