[project @ 2004-08-13 13:04:50 by simonmar]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcRnTypes.lhs
index 8b5bc3b..3f34791 100644 (file)
@@ -30,7 +30,8 @@ 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,
 
@@ -40,8 +41,8 @@ module TcRnTypes(
 
 #include "HsVersions.h"
 
-import HsSyn           ( PendingSplice, HsOverLit, MonoBinds, RuleDecl, ForeignDecl )
-import RnHsSyn         ( RenamedPat, RenamedArithSeqInfo )
+import HsSyn           ( PendingSplice, HsOverLit, LHsBind, LRuleDecl, LForeignDecl,
+                         Pat, ArithSeqInfo )
 import HscTypes                ( FixityEnv,
                          HscEnv, TypeEnv, TyThing, 
                          Avails, GenAvailInfo(..), AvailInfo,
@@ -61,7 +62,7 @@ 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 )
@@ -155,14 +156,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 +187,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   :: Bag (LHsBind 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}
 
@@ -253,7 +261,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 +269,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
@@ -348,15 +360,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 +443,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")
@@ -710,16 +721,19 @@ 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
+
+instLocSrcSpan :: InstLoc -> SrcSpan
+instLocSrcSpan (InstLoc _ src_span _) = src_span
 
 data InstOrigin
   = OccurrenceOf Name          -- Occurrence of an overloaded identifier
 
-  | IPOcc (IPName Name)                -- Occurrence of an implicit parameter
-  | IPBind (IPName Name)       -- Binding site of an implicit parameter
+  | IPOccOrigin  (IPName Name) -- Occurrence of an implicit parameter
+  | IPBindOrigin (IPName Name) -- Binding site of an implicit parameter
 
   | RecordUpdOrigin
 
@@ -729,10 +743,10 @@ data InstOrigin
 
   | LiteralOrigin HsOverLit    -- Occurrence of a literal
 
-  | PatOrigin RenamedPat
+  | PatOrigin (Pat Name)
 
-  | 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
@@ -768,9 +782,9 @@ pprInstLoc (InstLoc orig locn ctxt)
   where
     pp_orig (OccurrenceOf name)
        = hsep [ptext SLIT("use of"), quotes (ppr name)]
-    pp_orig (IPOcc name)
+    pp_orig (IPOccOrigin name)
        = hsep [ptext SLIT("use of implicit parameter"), quotes (ppr name)]
-    pp_orig (IPBind name)
+    pp_orig (IPBindOrigin name)
        = hsep [ptext SLIT("binding for implicit parameter"), quotes (ppr name)]
     pp_orig RecordUpdOrigin
        = ptext SLIT("a record update")