Refactoring: mainly rename ic_env_tvs to ic_untch

[ghc-hetmet.git] / compiler / typecheck / TcRnTypes.lhs

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 7357669..253a5c0 100644 (file)
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -256,6 +256,7 @@ data TcGblEnv
 
         tcg_ev_binds  :: Bag EvBind,       -- Top-level evidence bindings
        tcg_binds     :: LHsBinds Id,       -- Value bindings in this module
 
         tcg_ev_binds  :: Bag EvBind,       -- Top-level evidence bindings
        tcg_binds     :: LHsBinds Id,       -- Value bindings in this module

+        tcg_sigs      :: NameSet,          -- ...Top-level names that *lack* a signature

        tcg_warns     :: Warnings,          -- ...Warnings and deprecations
        tcg_anns      :: [Annotation],      -- ...Annotations
        tcg_insts     :: [Instance],        -- ...Instances
        tcg_warns     :: Warnings,          -- ...Warnings and deprecations
        tcg_anns      :: [Annotation],      -- ...Annotations
        tcg_insts     :: [Instance],        -- ...Instances

@@ -702,11 +703,11 @@ type GivenLoc  = CtLoc SkolemInfo
 
 data Implication
   = Implic {  
 
 data Implication
   = Implic {  

-      ic_env_tvs :: Untouchables, -- Untouchables: unification variables
+      ic_untch :: Untouchables, -- Untouchables: unification variables

                                   -- free in the environment
                                   -- free in the environment

-      ic_env     :: TcTypeEnv,    -- The type environment
+      ic_env   :: TcTypeEnv,    -- The type environment

                                  -- Used only when generating error messages
                                  -- Used only when generating error messages

-         -- Generally, ic_env_tvs = tvsof(ic_env)
+         -- Generally, ic_untch is a superset of tvsof(ic_env)

          -- However, we don't zonk ic_env when zonking the Implication
          -- Instead we do that when generating a skolem-escape error message
 
          -- However, we don't zonk ic_env when zonking the Implication
          -- Instead we do that when generating a skolem-escape error message
 

@@ -812,10 +813,10 @@ pprWantedEvVarWithLoc (WantedEvVar v loc) = hang (pprEvVarWithType v)
 pprWantedEvVar        (WantedEvVar v _)   = pprEvVarWithType v
 
 instance Outputable Implication where
 pprWantedEvVar        (WantedEvVar v _)   = pprEvVarWithType v
 
 instance Outputable Implication where

-  ppr (Implic { ic_env_tvs = env_tvs, ic_skols = skols, ic_given = given
+  ppr (Implic { ic_untch = untch, ic_skols = skols, ic_given = given

               , ic_wanted = wanted, ic_binds = binds, ic_loc = loc })
    = ptext (sLit "Implic") <+> braces 
               , ic_wanted = wanted, ic_binds = binds, ic_loc = loc })
    = ptext (sLit "Implic") <+> braces 

-     (sep [ ptext (sLit "Untouchables = ") <+> ppr env_tvs
+     (sep [ ptext (sLit "Untouchables = ") <+> ppr untch

           , ptext (sLit "Skolems = ") <+> ppr skols
           , ptext (sLit "Given = ") <+> pprEvVars given
           , ptext (sLit "Wanted = ") <+> ppr wanted
           , ptext (sLit "Skolems = ") <+> ppr skols
           , ptext (sLit "Given = ") <+> pprEvVars given
           , ptext (sLit "Wanted = ") <+> ppr wanted

@@ -848,13 +849,12 @@ ctLocOrigin (CtLoc o _ _) = o
 setCtLocOrigin :: CtLoc o -> o' -> CtLoc o'
 setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c
 
 setCtLocOrigin :: CtLoc o -> o' -> CtLoc o'
 setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c
 

-pprArising :: CtLoc CtOrigin -> SDoc
-pprArising loc = case ctLocOrigin loc of
-                   TypeEqOrigin -> empty
-                   _ -> text "arising from" <+> ppr (ctLocOrigin loc)
+pprArising :: CtOrigin -> SDoc
+pprArising (TypeEqOrigin {}) = empty
+pprArising orig              = text "arising from" <+> ppr orig

 
 pprArisingAt :: CtLoc CtOrigin -> SDoc
 
 pprArisingAt :: CtLoc CtOrigin -> SDoc

-pprArisingAt loc = sep [pprArising loc, text "at" <+> ppr (ctLocSpan loc)]
+pprArisingAt (CtLoc o s _) = sep [pprArising o, text "at" <+> ppr s]

 
 -------------------------------------------
 -- CtOrigin gives the origin of *wanted* constraints
 
 -------------------------------------------
 -- CtOrigin gives the origin of *wanted* constraints

@@ -864,7 +864,7 @@ data CtOrigin
 
   | SpecPragOrigin Name                -- Specialisation pragma for identifier
 
 
   | SpecPragOrigin Name                -- Specialisation pragma for identifier
 

-  | TypeEqOrigin
+  | TypeEqOrigin EqOrigin

 
   | IPOccOrigin  (IPName Name) -- Occurrence of an implicit parameter
 
 
   | IPOccOrigin  (IPName Name) -- Occurrence of an implicit parameter
 

@@ -919,7 +919,7 @@ pprO StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration")
 pprO DefaultOrigin        = ptext (sLit "a 'default' declaration")
 pprO DoOrigin             = ptext (sLit "a do statement")
 pprO ProcOrigin                   = ptext (sLit "a proc expression")
 pprO DefaultOrigin        = ptext (sLit "a 'default' declaration")
 pprO DoOrigin             = ptext (sLit "a do statement")
 pprO ProcOrigin                   = ptext (sLit "a proc expression")

-pprO TypeEqOrigin          = ptext (sLit "an equality")
+pprO (TypeEqOrigin eq)     = ptext (sLit "an equality") <+> ppr eq

 pprO AnnOrigin             = ptext (sLit "an annotation")
 
 instance Outputable EqOrigin where
 pprO AnnOrigin             = ptext (sLit "an annotation")
 
 instance Outputable EqOrigin where