[project @ 2004-11-25 11:36:34 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcRnTypes.lhs
index 8b5bc3b..df7dc46 100644 (file)
@@ -20,7 +20,7 @@ module TcRnTypes(
        WhereFrom(..), mkModDeps,
 
        -- Typechecker types
-       TcTyThing(..),
+       TcTyThing(..), GadtRefinement,
 
        -- Template Haskell
        ThStage(..), topStage, topSpliceStage,
@@ -30,24 +30,26 @@ module TcRnTypes(
        ArrowCtxt(..), topArrowCtxt, ProcLevel, topProcLevel, 
 
        -- Insts
-       Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, instLocSrcLoc,
+       Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, 
+       instLocSrcLoc, instLocSrcSpan,
        LIE, emptyLIE, unitLIE, plusLIE, consLIE, 
        plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,
 
        -- Misc other types
-       TcId, TcIdSet
+       TcId, TcIdSet, TcDictBinds
   ) where
 
 #include "HsVersions.h"
 
-import HsSyn           ( PendingSplice, HsOverLit, MonoBinds, RuleDecl, ForeignDecl )
-import RnHsSyn         ( RenamedPat, RenamedArithSeqInfo )
+import HsSyn           ( PendingSplice, HsOverLit, LRuleDecl, LForeignDecl,
+                         ArithSeqInfo, DictBinds, LHsBinds )
 import HscTypes                ( FixityEnv,
                          HscEnv, TypeEnv, TyThing, 
-                         Avails, GenAvailInfo(..), AvailInfo,
+                         GenAvailInfo(..), AvailInfo,
                          availName, IsBootInterface, Deprecations )
 import Packages                ( PackageName )
-import TcType          ( TcTyVarSet, TcType, TcTauType, TcThetaType, 
+import Type            ( Type, TvSubstEnv )
+import TcType          ( TcTyVarSet, TcType, TcTauType, TcThetaType, SkolemInfo,
                          TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes )
 import InstEnv         ( DFunId, InstEnv )
 import IOEnv
@@ -56,12 +58,10 @@ import Name         ( Name )
 import NameEnv
 import NameSet         ( NameSet, emptyNameSet, DefUses )
 import OccName         ( OccEnv )
-import Type            ( Type )
-import Class           ( Class )
 import Var             ( Id, TyVar )
 import VarEnv          ( TidyEnv )
 import Module
-import SrcLoc          ( SrcLoc )
+import SrcLoc          ( SrcSpan, SrcLoc, srcSpanStart )
 import VarSet          ( IdSet )
 import ErrUtils                ( Messages, Message )
 import UniqSupply      ( UniqSupply )
@@ -84,9 +84,12 @@ import ListSetOps    ( unionLists )
 The monad itself has to be defined here, because it is mentioned by ErrCtxt
 
 \begin{code}
-type TcRef a = IORef a
-type TcId    = Id                      -- Type may be a TcType
-type TcIdSet = IdSet
+type TcRef a    = IORef a
+type TcId       = Id                   -- Type may be a TcType
+type TcIdSet    = IdSet
+type TcDictBinds = DictBinds TcId      -- Bag of dictionary bindings
+
+
 
 type TcRnIf a b c = IOEnv (Env a b) c
 type IfM lcl a  = TcRnIf IfGblEnv lcl a                -- Iface stuff
@@ -108,14 +111,14 @@ type TcM  a = TcRn a              -- Historical
 data Env gbl lcl       -- Changes as we move into an expression
   = Env {
        env_top  :: HscEnv,     -- Top-level stuff that never changes
-                               --   Includes all info about imported things
+                               -- Includes all info about imported things
 
        env_us   :: TcRef UniqSupply,   -- Unique supply for local varibles
 
        env_gbl  :: gbl,        -- Info about things defined at the top level
-                               --   of the module being compiled
+                               -- of the module being compiled
 
-       env_lcl  :: lcl         -- Nested stuff -- changes as we go into 
+       env_lcl  :: lcl         -- Nested stuff; changes as we go into 
                                -- an expression
     }
 
@@ -147,22 +150,14 @@ data TcGblEnv
        
        tcg_inst_env :: InstEnv,        -- Instance envt for *home-package* modules
                                        -- Includes the dfuns in tcg_insts
-       tcg_inst_uses :: TcRef NameSet, -- Home-package Dfuns actually used 
-               -- Used to generate version dependencies
-               -- This records usages, rather like tcg_dus, but it has to
-               -- be a mutable variable so it can be augmented 
-               -- when we look up an instance.  These uses of dfuns are
-               -- rather like the free variables of the program, but
-               -- are implicit instead of explicit.
-
                -- Now a bunch of things about this module that are simply 
                -- accumulated, but never consulted until the end.  
                -- Nevertheless, it's convenient to accumulate them along 
                -- with the rest of the info from this module.
-       tcg_exports :: Avails,                  -- What is exported
-       tcg_imports :: ImportAvails,            -- Information about what was imported 
-                                               --    from where, including things bound
-                                               --    in this module
+       tcg_exports :: NameSet,         -- What is exported
+       tcg_imports :: ImportAvails,    -- Information about what was imported 
+                                       --    from where, including things bound
+                                       --    in this module
 
        tcg_dus :: DefUses,     -- What is defined in this module and what is used.
                                -- The latter is used to generate 
@@ -170,20 +165,42 @@ data TcGblEnv
                                --              things have not changed version stamp
                                --      (b) unused-import info
 
-       tcg_keep :: NameSet,    -- Set of names to keep alive, and to expose in the 
-                               -- interface file (but not to export to the user).
-                               -- These are typically extra definitions generated from
-                               -- data type declarations which would otherwise be
-                               -- dropped as dead code.  
+       tcg_keep :: TcRef NameSet,      -- Locally-defined top-level names to keep alive
+               -- "Keep alive" means give them an Exported flag, so
+               -- that the simplifier does not discard them as dead 
+               -- code, and so that they are exposed in the interface file
+               -- (but not to export to the user).
+               --
+               -- Some things, like dict-fun Ids and default-method Ids are 
+               -- "born" with the Exported flag on, for exactly the above reason,
+               -- but some we only discover as we go.  Specifically:
+               --      * The to/from functions for generic data types
+               --      * Top-level variables appearing free in the RHS of an orphan rule
+               --      * Top-level variables appearing free in a TH bracket
+
+       tcg_inst_uses :: TcRef NameSet, -- Home-package Dfuns actually used 
+               -- Used to generate version dependencies
+               -- This records usages, rather like tcg_dus, but it has to
+               -- be a mutable variable so it can be augmented 
+               -- when we look up an instance.  These uses of dfuns are
+               -- rather like the free variables of the program, but
+               -- are implicit instead of explicit.
+
+       tcg_th_used :: TcRef Bool,      -- True <=> Template Haskell syntax used
+               -- We need this so that we can generate a dependency on the
+               -- Template Haskell package, becuase the desugarer is going to
+               -- emit loads of references to TH symbols.  It's rather like 
+               -- tcg_inst_uses; the reference is implicit rather than explicit,
+               -- so we have to zap a mutable variable.
 
                -- 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_binds   :: LHsBinds Id,             -- Value bindings in this module
        tcg_deprecs :: Deprecations,            -- ...Deprecations 
        tcg_insts   :: [DFunId],                -- ...Instances
-       tcg_rules   :: [RuleDecl Id],           -- ...Rules
-       tcg_fords   :: [ForeignDecl Id]         -- ...Foreign import & exports
+       tcg_rules   :: [LRuleDecl Id],          -- ...Rules
+       tcg_fords   :: [LForeignDecl Id]        -- ...Foreign import & exports
     }
 \end{code}
 
@@ -202,17 +219,10 @@ data IfGblEnv
        -- was originally a hi-boot file.
        -- We need the module name so we can test when it's appropriate
        -- to look in this env.
-       if_rec_types :: Maybe (Module, IfG TypeEnv),
+       if_rec_types :: Maybe (Module, IfG TypeEnv)
                -- Allows a read effect, so it can be in a mutable
                -- variable; c.f. handling the external package type env
                -- Nothing => interactive stuff, no loops possible
-
-       if_is_boot   :: ModuleEnv (ModuleName, IsBootInterface)
-       -- Tells what we know about boot interface files
-       -- When we're importing a module we know absolutely
-       -- nothing about, so we assume it's from
-       -- another package, where we aren't doing 
-       -- dependency tracking. So it won't be a hi-boot file.
     }
 
 data IfLclEnv
@@ -253,7 +263,7 @@ Why?  Because they are now Ids not TcIds.  This final GlobalEnv is
 data TcLclEnv          -- Changes as we move inside an expression
                        -- Discarded after typecheck/rename; not passed on to desugarer
   = TcLclEnv {
-       tcl_loc  :: SrcLoc,             -- Source location
+       tcl_loc  :: SrcSpan,            -- Source span
        tcl_ctxt :: ErrCtxt,            -- Error context
        tcl_errs :: TcRef Messages,     -- Place to accumulate errors
 
@@ -261,6 +271,10 @@ data TcLclEnv              -- Changes as we move inside an expression
        tcl_arrow_ctxt :: ArrowCtxt,    -- Arrow-notation context
 
        tcl_rdr :: LocalRdrEnv,         -- Local name envt
+               -- Maintained during renaming, of course, but also during
+               -- type checking, solely so that when renaming a Template-Haskell
+               -- splice we have the right environment for the renamer.
+               -- 
                --   Does *not* include global name envt; may shadow it
                --   Includes both ordinary variables and type variables;
                --   they are kept distinct because tyvar have a different
@@ -268,22 +282,58 @@ data TcLclEnv             -- Changes as we move inside an expression
                -- We still need the unsullied global name env so that
                --   we can look up record field names
 
-       tcl_env    :: NameEnv TcTyThing,  -- The local type environment: Ids and TyVars
-                                         -- defined in this module
+       tcl_env  :: NameEnv TcTyThing,  -- The local type environment: Ids and TyVars
+                                       -- defined in this module
                                        
        tcl_tyvars :: TcRef TcTyVarSet, -- The "global tyvars"
-                       -- Namely, the in-scope TyVars bound in tcl_lenv, 
+                       -- Namely, the in-scope TyVars bound in tcl_env, 
                        -- plus the tyvars mentioned in the types of Ids bound in tcl_lenv
                        -- Why mutable? see notes with tcGetGlobalTyVars
 
-       tcl_lie :: TcRef LIE            -- Place to accumulate type constraints
+       tcl_lie   :: TcRef LIE,         -- Place to accumulate type constraints
+       tcl_gadt  :: GadtRefinement     -- The current type refinement for GADTs
+
+-----------------------------------------------------------
+-- Not yet; it's a new complication and I want to see whether it bites
+--     tcl_given :: [Inst]             -- Insts available in the current context (see Note [Given Insts])
+-----------------------------------------------------------
     }
 
+type GadtRefinement = TvSubstEnv       -- Binds rigid type variables to their refinements
+
+{- Note [Given Insts]
+   ~~~~~~~~~~~~~~~~~~
+Because of GADTs, we have to pass inwards the Insts provided by type signatures 
+and existential contexts. Consider
+       data T a where { T1 :: b -> b -> T [b] }
+       f :: Eq a => T a -> Bool
+       f (T1 x y) = [x]==[y]
+
+The constructor T1 binds an existential variable 'b', and we need Eq [b].
+Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we 
+pass it inwards.
+
+-}
+
 ---------------------------
 -- Template Haskell levels 
 ---------------------------
 
-type ThLevel = Int     -- Always >= 0
+type ThLevel = Int     
+       -- Indicates how many levels of brackets we are inside
+       --      (always >= 0)
+       -- Incremented when going inside a bracket,
+       -- decremented when going inside a splice
+
+impLevel, topLevel :: ThLevel
+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: 
+--     f = ...
+--     g1 = $(map ...)         is OK
+--     g2 = $(f ...)           is not OK; because we havn't compiled f yet
+
 
 data ThStage
   = Comp                               -- Ordinary compiling, at level topLevel
@@ -296,16 +346,6 @@ topStage       = Comp
 topSpliceStage = Splice (topLevel - 1) -- Stage for the body of a top-level splice
 
 
-impLevel, topLevel :: ThLevel
-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: 
---     f = ...
---     g1 = $(map ...)         is OK
---     g2 = $(f ...)           is not OK; because we havn't compiled f yet
-
-
 ---------------------------
 -- Arrow-notation stages
 ---------------------------
@@ -348,15 +388,14 @@ data TcTyThing
   = AGlobal TyThing                    -- Used only in the return type of a lookup
   | ATcId   TcId ThLevel ProcLevel     -- Ids defined in this module; may not be fully zonked
   | ATyVar  TyVar                      -- Type variables
-  | ARecTyCon TcKind                   -- Used temporarily, during kind checking, for the
-  | ARecClass TcKind                   --      tycons and clases in this recursive group
+  | AThing  TcKind                     -- Used temporarily, during kind checking, for the
+                                       --      tycons and clases in this recursive group
 
 instance Outputable TcTyThing where    -- Debugging only
    ppr (AGlobal g)      = text "AGlobal" <+> ppr g
    ppr (ATcId g tl pl)  = text "ATcId" <+> ppr g <+> ppr tl <+> ppr pl
    ppr (ATyVar t)       = text "ATyVar" <+> ppr t
-   ppr (ARecTyCon k)    = text "ARecTyCon" <+> ppr k
-   ppr (ARecClass k)    = text "ARecClass" <+> ppr k
+   ppr (AThing k)       = text "AThing" <+> ppr k
 \end{code}
 
 \begin{code}
@@ -432,7 +471,7 @@ data ImportAvails
                -- combine stuff coming from different (unqualified) 
                -- imports of the same module
 
-       imp_mods :: ModuleEnv (Module, Maybe Bool),
+       imp_mods :: ModuleEnv (Module, Maybe Bool, SrcSpan),
                -- Domain is all directly-imported modules
                -- Maybe value answers the question "is the import restricted?"
                --   Nothing    => unrestricted import (e.g., "import Foo")
@@ -605,7 +644,7 @@ type Int, represented by
 \begin{code}
 data Inst
   = Dict
-       Id
+       Name
        TcPredType
        InstLoc
 
@@ -634,13 +673,13 @@ data Inst
        --      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 
+       --   Reason: two methods are considered 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
+       Name
        HsOverLit       -- The literal from the occurrence site
                        --      INVARIANT: never a rebindable-syntax literal
                        --      Reason: tcSyntaxName does unification, and we
@@ -710,97 +749,63 @@ It appears in TcMonad because there are a couple of error-message-generation
 functions that deal with it.
 
 \begin{code}
-data InstLoc = InstLoc InstOrigin SrcLoc ErrCtxt
+data InstLoc = InstLoc InstOrigin SrcSpan ErrCtxt
 
 instLocSrcLoc :: InstLoc -> SrcLoc
-instLocSrcLoc (InstLoc _ src_loc _) = src_loc
+instLocSrcLoc (InstLoc _ src_span _) = srcSpanStart src_span
 
-data InstOrigin
-  = OccurrenceOf Name          -- Occurrence of an overloaded identifier
+instLocSrcSpan :: InstLoc -> SrcSpan
+instLocSrcSpan (InstLoc _ src_span _) = src_span
 
-  | IPOcc (IPName Name)                -- Occurrence of an implicit parameter
-  | IPBind (IPName Name)       -- Binding site of an implicit parameter
+data InstOrigin
+  = SigOrigin SkolemInfo       -- Pattern, class decl, inst decl etc;
+                               -- Places that bind type variables and introduce
+                               -- available constraints
 
-  | RecordUpdOrigin
+  | IPBindOrigin (IPName Name) -- Binding site of an implicit parameter
 
-  | DataDeclOrigin             -- Typechecking a data declaration
+       -------------------------------------------------------
+       -- The rest are all occurrences: Insts that are 'wanted'
+       -------------------------------------------------------
+  | OccurrenceOf Name          -- Occurrence of an overloaded identifier
 
-  | InstanceDeclOrigin         -- Typechecking an instance decl
+  | IPOccOrigin  (IPName Name) -- Occurrence of an implicit parameter
 
   | LiteralOrigin HsOverLit    -- Occurrence of a literal
 
-  | PatOrigin RenamedPat
-
-  | ArithSeqOrigin RenamedArithSeqInfo -- [x..], [x..y] etc
-  | PArrSeqOrigin  RenamedArithSeqInfo -- [:x..y:] and [:x,y..z:]
+  | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc
+  | PArrSeqOrigin  (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:]
 
-  | SignatureOrigin            -- A dict created from a type signature
-  | Rank2Origin                        -- A dict created when typechecking the argument
-                               -- of a rank-2 typed function
+  | InstSigOrigin      -- A dict occurrence arising from instantiating
+                       -- a polymorphic type during a subsumption check
 
-  | DoOrigin                   -- The monad for a do expression
-  | ProcOrigin                 -- A proc expression
-
-  | ClassDeclOrigin            -- Manufactured during a class decl
-
-  | InstanceSpecOrigin Class   -- in a SPECIALIZE instance pragma
-                       Type
-
-       -- When specialising instances the instance info attached to
-       -- each class is not yet ready, so we record it inside the
-       -- origin information.  This is a bit of a hack, but it works
-       -- fine.  (Patrick is to blame [WDP].)
-
-  | ValSpecOrigin      Name    -- in a SPECIALIZE pragma for a value
-
-       -- Argument or result of a ccall
-       -- Dictionaries with this origin aren't actually mentioned in the
-       -- translated term, and so need not be bound.  Nor should they
-       -- be abstracted over.
-
-  | UnknownOrigin      -- Help! I give up...
+  | RecordUpdOrigin
+  | InstScOrigin       -- Typechecking superclasses of an instance declaration
+  | DerivOrigin                -- Typechecking deriving
+  | DefaultOrigin      -- Typechecking a default decl
+  | DoOrigin           -- Arising from a do expression
+  | ProcOrigin         -- Arising from a proc expression
 \end{code}
 
 \begin{code}
 pprInstLoc :: InstLoc -> SDoc
-pprInstLoc (InstLoc orig locn ctxt)
+pprInstLoc (InstLoc (SigOrigin info) locn _) 
+  = text "arising from" <+> ppr info   -- I don't think this happens much, if at all
+pprInstLoc (InstLoc orig locn _)
   = hsep [text "arising from", pp_orig orig, text "at", ppr locn]
   where
-    pp_orig (OccurrenceOf name)
-       = hsep [ptext SLIT("use of"), quotes (ppr name)]
-    pp_orig (IPOcc name)
-       = hsep [ptext SLIT("use of implicit parameter"), quotes (ppr name)]
-    pp_orig (IPBind name)
-       = hsep [ptext SLIT("binding for implicit parameter"), quotes (ppr name)]
-    pp_orig RecordUpdOrigin
-       = ptext SLIT("a record update")
-    pp_orig DataDeclOrigin
-       = ptext SLIT("the data type declaration")
-    pp_orig InstanceDeclOrigin
-       = ptext SLIT("the instance declaration")
-    pp_orig (LiteralOrigin lit)
-       = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
-    pp_orig (PatOrigin pat)
-       = hsep [ptext SLIT("the pattern"), quotes (ppr pat)]
-    pp_orig (ArithSeqOrigin seq)
-       = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
-    pp_orig (PArrSeqOrigin seq)
-       = hsep [ptext SLIT("the parallel array sequence"), quotes (ppr seq)]
-    pp_orig (SignatureOrigin)
-       =  ptext SLIT("a type signature")
-    pp_orig (Rank2Origin)
-       =  ptext SLIT("a function with an overloaded argument type")
-    pp_orig (DoOrigin)
-       =  ptext SLIT("a do statement")
-    pp_orig (ProcOrigin)
-       =  ptext SLIT("a proc expression")
-    pp_orig (ClassDeclOrigin)
-       =  ptext SLIT("a class declaration")
-    pp_orig (InstanceSpecOrigin clas ty)
-       = hsep [text "a SPECIALIZE instance pragma; class",
-               quotes (ppr clas), text "type:", ppr ty]
-    pp_orig (ValSpecOrigin name)
-       = hsep [ptext SLIT("a SPECIALIZE user-pragma for"), quotes (ppr name)]
-    pp_orig (UnknownOrigin)
-       = ptext SLIT("...oops -- I don't know where the overloading came from!")
+    pp_orig (OccurrenceOf name)  = hsep [ptext SLIT("use of"), quotes (ppr name)]
+    pp_orig (IPOccOrigin name)   = hsep [ptext SLIT("use of implicit parameter"), quotes (ppr name)]
+    pp_orig (IPBindOrigin name)  = hsep [ptext SLIT("binding for implicit parameter"), quotes (ppr name)]
+    pp_orig RecordUpdOrigin     = ptext SLIT("a record update")
+    pp_orig (LiteralOrigin lit)         = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
+    pp_orig (ArithSeqOrigin seq) = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
+    pp_orig (PArrSeqOrigin seq)         = hsep [ptext SLIT("the parallel array sequence"), quotes (ppr seq)]
+    pp_orig InstSigOrigin       =  ptext SLIT("instantiating a type signature")
+    pp_orig InstScOrigin        =  ptext SLIT("the superclasses of an instance declaration")
+    pp_orig DerivOrigin                 = ptext SLIT("the 'deriving' clause of a data type declaration")
+    pp_orig DefaultOrigin       = ptext SLIT("a 'default' declaration")
+    pp_orig DoOrigin            =  ptext SLIT("a do statement")
+    pp_orig ProcOrigin          =  ptext SLIT("a proc expression")
+    pp_orig (SigOrigin info)    = ppr info
 \end{code}