[project @ 2003-02-21 12:16:44 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcRnTypes.lhs
index 81909bf..1e58edd 100644 (file)
@@ -19,10 +19,11 @@ module TcRnTypes(
 
        -- Ranamer types
        RnMode(..), isInterfaceMode, isCmdLineMode,
-       Usages(..), emptyUsages, ErrCtxt,
-       ImportAvails(..), emptyImportAvails, plusImportAvails, mkImportAvails,
+       EntityUsage, emptyUsages, ErrCtxt,
+       ImportAvails(..), emptyImportAvails, plusImportAvails, 
        plusAvail, pruneAvails,  
-       AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv, lookupAvailEnv, availEnvElts, addAvail,
+       AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv, 
+       mkAvailEnv, lookupAvailEnv, availEnvElts, addAvail,
        WhereFrom(..),
 
        -- Typechecker types
@@ -33,7 +34,7 @@ module TcRnTypes(
        Level, impLevel, topLevel,
 
        -- Insts
-       Inst(..), InstOrigin(..), InstLoc, pprInstLoc,
+       Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, instLocSrcLoc,
        LIE, emptyLIE, unitLIE, plusLIE, consLIE, 
        plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,
 
@@ -48,7 +49,8 @@ import RnHsSyn                ( RenamedHsExpr, RenamedPat, RenamedArithSeqInfo )
 import HscTypes                ( GhciMode, ExternalPackageState, HomePackageTable, NameCache,
                          GlobalRdrEnv, LocalRdrEnv, FixityEnv, TypeEnv, TyThing, 
                          Avails, GenAvailInfo(..), AvailInfo, availName,
-                         IsBootInterface, Deprecations, unQualInScope )
+                         IsBootInterface, Deprecations )
+import Packages                ( PackageName )
 import TcType          ( TcTyVarSet, TcType, TcTauType, TcThetaType, TcPredType, TcKind,
                          tcCmpPred, tcCmpType, tcCmpTypes )
 import InstEnv         ( DFunId, InstEnv )
@@ -72,9 +74,10 @@ import Outputable
 import DATA_IOREF      ( IORef, newIORef, readIORef, writeIORef )
 import UNSAFE_IO       ( unsafeInterleaveIO )
 import FIX_IO          ( fixIO )
+import EXCEPTION       ( Exception )
 import Maybe           ( mapMaybe )
-import List            ( nub )
-import Control.Exception as Exception ( try, Exception )
+import ListSetOps      ( unionLists )
+import Panic           ( tryMost )
 \end{code}
 
 
@@ -152,9 +155,9 @@ fixM f = TcRn (\ env -> fixIO (\ r -> unTcRn (f r) env))
 Error recovery
 
 \begin{code}
-tryM :: TcRn m r -> TcRn m (Either Exception.Exception r)
+tryM :: TcRn m r -> TcRn m (Either Exception r)
 -- Reflect exception into TcRn monad
-tryM (TcRn thing) = TcRn (\ env -> Exception.try (thing env))
+tryM (TcRn thing) = TcRn (\ env -> tryMost (thing env))
 \end{code}
 
 Lazy interleave 
@@ -232,6 +235,7 @@ data TopEnv -- Built once at top level then does not change
                -- PIT, ImportedModuleInfo
                -- DeclsMap, IfaceRules, IfaceInsts, InstGates
                -- TypeEnv, InstEnv, RuleBase
+               -- Mutable, because we demand-load declarations that extend the state
 
        top_hpt  :: HomePackageTable,
                -- The home package table that we've accumulated while 
@@ -257,9 +261,8 @@ data TopEnv -- Built once at top level then does not change
 data TcGblEnv
   = TcGblEnv {
        tcg_mod    :: Module,           -- Module being compiled
-       tcg_usages :: TcRef Usages,     -- What version of what entities 
-                                       -- have been used from other modules
-                                       -- (whether home or ext-package modules)
+       tcg_usages :: TcRef EntityUsage,  -- What version of what entities 
+                                         -- have been used from other home-pkg modules
        tcg_rdr_env :: GlobalRdrEnv,    -- Top level envt; used during renaming
        tcg_fix_env :: FixityEnv,       -- Ditto
        tcg_default :: [Type],          -- Types used for defaulting
@@ -271,15 +274,20 @@ data TcGblEnv
                -- (Ids defined in this module start in the local envt, 
                --  though they move to the global envt during zonking)
        
-               -- Cached things
-       tcg_ist :: Name -> Maybe TyThing,       -- Imported symbol table
-               -- Global type env: a combination of tcg_eps, tcg_hpt
-               --      (but *not* tcg_type_env; no deep reason)
-               -- When the PCS changes this must be refreshed, 
-               -- notably after running some compile-time code
-       
-       tcg_inst_env :: InstEnv,        -- Global instance env: a combination of 
+       tcg_inst_env :: TcRef InstEnv,  -- Global instance env: a combination of 
                                        --      tc_pcs, tc_hpt, *and* tc_insts
+               -- This field is mutable so that it can be updated inside a
+               -- Template Haskell splice, which might suck in some new
+               -- instance declarations.  This is a slightly different strategy
+               -- than for the type envt, where we look up first in tcg_type_env
+               -- and then in the mutable EPS, because the InstEnv for this module
+               -- is constructed (in principle at least) only from the modules
+               -- 'below' this one, so it's this-module-specific
+               --
+               -- On the other hand, a declaration quote [d| ... |] may introduce
+               -- some new instance declarations that we *don't* want to persist
+               -- outside the quote, so we tiresomely need to revert the InstEnv
+               -- after finishing the quote (see TcSplice.tcBracket)
 
                -- Now a bunch of things about this module that are simply 
                -- accumulated, but never consulted until the end.  
@@ -289,7 +297,10 @@ data TcGblEnv
        tcg_imports :: ImportAvails,            -- Information about what was imported 
                                                --    from where, including things bound
                                                --    in this module
-               -- The next fields are always fully zonked
+
+               -- The next fields accumulate the payload of the module
+               -- The binds, rules and foreign-decl fiels are collected
+               -- initially in un-zonked form and are finally zonked in tcRnSrcDecls
        tcg_binds   :: MonoBinds Id,            -- Value bindings in this module
        tcg_deprecs :: Deprecations,            -- ...Deprecations 
        tcg_insts   :: [DFunId],                -- ...Instances
@@ -353,7 +364,7 @@ topSpliceStage = Splice (topLevel - 1)      -- Stage for the body of a top-level spli
 
 
 impLevel, topLevel :: Level
-topLevel = 1   -- Things dedined at top level of this module
+topLevel = 1   -- Things defined at top level of this module
 impLevel = 0   -- Imported things; they can be used inside a top level splice
 --
 -- For example: 
@@ -372,6 +383,12 @@ data TcTyThing
 --     2. Then we kind-check the (T a Int) part.
 --     3. Then we zonk the kind variable.
 --     4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
+
+instance Outputable TcTyThing where    -- Debugging only
+   ppr (AGlobal g) = text "AGlobal" <+> ppr g
+   ppr (ATcId g l) = text "ATcId" <+> ppr g <+> ppr l
+   ppr (ATyVar t)  = text "ATyVar" <+> ppr t
+   ppr (AThing k)  = text "AThing" <+> ppr k
 \end{code}
 
 \begin{code}
@@ -415,34 +432,27 @@ isCmdLineMode _ = False
 
 %************************************************************************
 %*                                                                     *
-                       Usages
+                       EntityUsage
 %*                                                                     *
 %************************************************************************
 
-Usages tells what things are actually need in order to compile this
-module.  It is used 
-       * for generating the usages field of the ModIface
-       * for reporting unused things in scope
+EntityUsage tells what things are actually need in order to compile this
+module.  It is used for generating the usage-version field of the ModIface.
 
-\begin{code}
-data Usages
-  = Usages {
-       usg_ext :: ModuleSet,
-               -- The non-home-package modules from which we have
-               -- slurped at least one name.
-
-       usg_home :: NameSet
-               -- The Names are all the (a) home-package
-               --                       (b) "big" (i.e. no data cons, class ops)
-               --                       (c) non-locally-defined
-               --                       (d) non-wired-in
-               -- names that have been slurped in so far.
-               -- This is used to generate the "usage" information for this module.
-    }
+Note that we do not record version info for entities from 
+other (non-home) packages.  If the package changes, GHC doesn't help.
 
-emptyUsages :: Usages
-emptyUsages = Usages { usg_ext = emptyModuleSet,
-                      usg_home = emptyNameSet }
+\begin{code}
+type EntityUsage = NameSet
+       -- The Names are all the (a) home-package
+       --                       (b) "big" (i.e. no data cons, class ops)
+       --                       (c) non-locally-defined
+       --                       (d) non-wired-in
+       -- names that have been slurped in so far.
+       -- This is used to generate the "usage" information for this module.
+
+emptyUsages :: EntityUsage
+emptyUsages = emptyNameSet
 \end{code}
 
 
@@ -468,15 +478,23 @@ data ImportAvails
                -- i.e. *excluding* class ops and constructors
                --      (which appear inside their parent AvailTC)
 
-       imp_unqual :: ModuleEnv Avails,
+       imp_qual :: ModuleEnv AvailEnv,
                -- Used to figure out "module M" export specifiers
-               -- Domain is only modules with *unqualified* imports
-               -- (see 1.4 Report Section 5.1.1)
-               -- The list of Avails is cumulative, not necessarily
-               -- nicely uniquified. For example, we might have Maybe(Nothing)
-               -- and Maybe(Just) in the list, separately.
-
-       imp_mods :: ModuleEnv (Module, Bool)
+               -- (see 1.4 Report Section 5.1.1).  Ultimately, we want to find 
+               -- everything that is unambiguously in scope as 'M.x'
+               -- and where plain 'x' is (perhaps ambiguously) in scope.
+               -- So the starting point is all things that are in scope as 'M.x',
+               -- which is what this field tells us.
+               --
+               -- Domain is the *module qualifier* for imports.
+               --   e.g.        import List as Foo
+               -- would add a binding Foo |-> ...stuff from List...
+               -- to imp_qual.
+               -- We keep the stuff as an AvailEnv so that it's easy to 
+               -- combine stuff coming from different (unqualified) 
+               -- imports of the same module
+
+       imp_mods :: ModuleEnv (Module, Bool),
                -- Domain is all directly-imported modules
                -- Bool is True if there was an unrestricted import
                --      (i.e. not a selective list)
@@ -487,45 +505,50 @@ data ImportAvails
                --       the interface file; if we import everything we
                --       need to recompile if the module version changes
                --   (b) to specify what child modules to initialise
+
+       imp_dep_mods :: ModuleEnv (ModuleName, IsBootInterface),
+               -- Home-package modules needed by the module being compiled
+               --
+               -- It doesn't matter whether any of these dependencies are actually
+               -- *used* when compiling the module; they are listed if they are below
+               -- it at all.  For example, suppose M imports A which imports X.  Then
+               -- compiling M might not need to consult X.hi, but X is still listed
+               -- in M's dependencies.
+
+       imp_dep_pkgs :: [PackageName],
+               -- Packages needed by the module being compiled, whether
+               -- directly, or via other modules in this package, or via
+               -- modules imported from other packages.
+
+       imp_orphs :: [ModuleName]
+               -- Orphan modules below us in the import tree
       }
 
 emptyImportAvails :: ImportAvails
-emptyImportAvails = ImportAvails { imp_env    = emptyAvailEnv, 
-                                  imp_unqual = emptyModuleEnv, 
-                                  imp_mods   = emptyModuleEnv }
+emptyImportAvails = ImportAvails { imp_env     = emptyAvailEnv, 
+                                  imp_qual     = emptyModuleEnv, 
+                                  imp_mods     = emptyModuleEnv,
+                                  imp_dep_mods = emptyModuleEnv,
+                                  imp_dep_pkgs = [],
+                                  imp_orphs    = [] }
 
 plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails
 plusImportAvails
-  (ImportAvails { imp_env = env1, imp_unqual = unqual1, imp_mods = mods1 })
-  (ImportAvails { imp_env = env2, imp_unqual = unqual2, imp_mods = mods2 })
-  = ImportAvails { imp_env    = env1 `plusAvailEnv` env2, 
-                  imp_unqual = plusModuleEnv_C (++) unqual1 unqual2, 
-                  imp_mods   = mods1 `plusModuleEnv` mods2 }
-
-mkImportAvails :: ModuleName -> Bool
-              -> GlobalRdrEnv -> [AvailInfo] -> ImportAvails
-mkImportAvails mod_name unqual_imp gbl_env avails 
-  = ImportAvails { imp_unqual = mod_avail_env, 
-                  imp_env    = entity_avail_env,
-                  imp_mods   = emptyModuleEnv }-- Stays empty for module being compiled;
-                                               -- gets updated for imported modules
+  (ImportAvails { imp_env = env1, imp_qual = unqual1, imp_mods = mods1,
+                 imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1, imp_orphs = orphs1 })
+  (ImportAvails { imp_env = env2, imp_qual = unqual2, imp_mods = mods2,
+                 imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2, imp_orphs = orphs2 })
+  = ImportAvails { imp_env      = env1 `plusAvailEnv` env2, 
+                  imp_qual     = plusModuleEnv_C plusAvailEnv unqual1 unqual2, 
+                  imp_mods     = mods1  `plusModuleEnv` mods2, 
+                  imp_dep_mods = plusModuleEnv_C plus_mod_dep dmods1 dmods2,   
+                  imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
+                  imp_orphs    = orphs1 `unionLists` orphs2 }
   where
-    mod_avail_env = unitModuleEnvByName mod_name unqual_avails 
-
-       -- unqual_avails is the Avails that are visible in *unqualified* form
-       -- We need to know this so we know what to export when we see
-       --      module M ( module P ) where ...
-       -- Then we must export whatever came from P unqualified.
-
-    unqual_avails | not unqual_imp = []        -- Short cut when no unqualified imports
-                 | otherwise      = pruneAvails (unQualInScope gbl_env) avails
-
-    entity_avail_env = foldl insert emptyAvailEnv avails
-    insert env avail = extendNameEnv_C plusAvail env (availName avail) avail
-       -- 'avails' may have several items with the same availName
-       -- E.g  import Ix( Ix(..), index )
-       -- will give Ix(Ix,index,range) and Ix(index)
-       -- We want to combine these
+    plus_mod_dep (m1, boot1) (m2, boot2) 
+       = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
+               -- Check mod-names match
+         (m1, boot1 && boot2)  -- If either side can "see" a non-hi-boot interface, use that
 \end{code}
 
 %************************************************************************
@@ -536,7 +559,7 @@ v%************************************************************************
 
 \begin{code}
 plusAvail (Avail n1)      (Avail n2)       = Avail n1
-plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
+plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
 -- Added SOF 4/97
 #ifdef DEBUG
 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
@@ -580,6 +603,13 @@ availEnvElts = nameEnvElts
 
 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
+
+mkAvailEnv :: [AvailInfo] -> AvailEnv
+       -- 'avails' may have several items with the same availName
+       -- E.g  import Ix( Ix(..), index )
+       -- will give Ix(Ix,index,range) and Ix(index)
+       -- We want to combine these; addAvail does that
+mkAvailEnv avails = foldl addAvail emptyAvailEnv avails
 \end{code}
 
 %************************************************************************
@@ -597,9 +627,7 @@ data WhereFrom
   | ImportForUsage IsBootInterface     -- Import when chasing usage info from an interaface file
                                        --      Failure in this case is not an error
 
-  | ImportBySystem                     -- Non user import.  Use eps_mod_info to decide whether
-                                       -- the module this module depends on, or is a system-ish module; 
-                                       -- M.hi-boot otherwise
+  | ImportBySystem                     -- Non user import.
 
 instance Outputable WhereFrom where
   ppr (ImportByUser is_boot) | is_boot     = ptext SLIT("{- SOURCE -}")
@@ -648,13 +676,19 @@ data Inst
        TcThetaType     -- The (types of the) dictionaries to which the function
                        -- must be applied to get the method
 
-       TcTauType       -- The type of the method
+       TcTauType       -- The tau-type of the method
 
        InstLoc
 
-       -- INVARIANT: in (Method u f tys theta tau loc)
+       -- INVARIANT 1: in (Method u f tys theta tau loc)
        --      type of (f tys dicts(from theta)) = tau
 
+       -- INVARIANT 2: tau must not be of form (Pred -> Tau)
+       --   Reason: two methods are considerd equal if the 
+       --           base Id matches, and the instantiating types
+       --           match.  The TcThetaType should then match too.
+       --   This only bites in the call to tcInstClassOp in TcClassDcl.mkMethodBind
+
   | LitInst
        Id
        HsOverLit       -- The literal from the occurrence site
@@ -726,7 +760,10 @@ It appears in TcMonad because there are a couple of error-message-generation
 functions that deal with it.
 
 \begin{code}
-type InstLoc = (InstOrigin, SrcLoc, ErrCtxt)
+data InstLoc = InstLoc InstOrigin SrcLoc ErrCtxt
+
+instLocSrcLoc :: InstLoc -> SrcLoc
+instLocSrcLoc (InstLoc _ src_loc _) = src_loc
 
 data InstOrigin
   = OccurrenceOf Name          -- Occurrence of an overloaded identifier
@@ -781,7 +818,7 @@ data InstOrigin
 
 \begin{code}
 pprInstLoc :: InstLoc -> SDoc
-pprInstLoc (orig, locn, ctxt)
+pprInstLoc (InstLoc orig locn ctxt)
   = hsep [text "arising from", pp_orig orig, text "at", ppr locn]
   where
     pp_orig (OccurrenceOf name)