[project @ 2004-10-11 16:16:20 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcRnTypes.lhs
index f7896ee..d30a6d6 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
     }
 
@@ -155,14 +158,21 @@ data TcGblEnv
                -- 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.
+
                -- 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 
@@ -179,11 +189,11 @@ data TcGblEnv
                -- 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 +212,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 +256,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
 
@@ -272,17 +275,39 @@ 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 
 ---------------------------
@@ -352,15 +377,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}
@@ -436,7 +460,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")
@@ -609,7 +633,7 @@ type Int, represented by
 \begin{code}
 data Inst
   = Dict
-       Id
+       Name
        TcPredType
        InstLoc
 
@@ -638,13 +662,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
@@ -714,97 +738,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:]
-
-  | SignatureOrigin            -- A dict created from a type signature
-  | Rank2Origin                        -- A dict created when typechecking the argument
-                               -- of a rank-2 typed function
-
-  | DoOrigin                   -- The monad for a do expression
-  | ProcOrigin                 -- A proc expression
+  | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc
+  | PArrSeqOrigin  (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:]
 
-  | ClassDeclOrigin            -- Manufactured during a class decl
+  | InstSigOrigin      -- A dict occurrence arising from instantiating
+                       -- a polymorphic type during a subsumption check
 
-  | 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}