Fix header locations
[ghc.git] / compiler / typecheck / TcRnMonad.hs
index 8f4812e..e0989ae 100644 (file)
@@ -89,7 +89,7 @@ module TcRnMonad(
 
   -- * Type constraints
   newTcEvBinds, newNoTcEvBinds,
-  addTcEvBind,
+  addTcEvBind, addTopEvBinds,
   getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap,
   chooseUniqueOccTc,
   getConstraintVar, setConstraintVar,
@@ -234,6 +234,12 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
              maybe_rn_syntax :: forall a. a -> Maybe a ;
              maybe_rn_syntax empty_val
                 | dopt Opt_D_dump_rn_ast dflags = Just empty_val
+
+                  -- We want to serialize the documentation in the .hi-files,
+                  -- and need to extract it from the renamed syntax first.
+                  -- See 'ExtractDocs.extractDocs'.
+                | gopt Opt_Haddock dflags       = Just empty_val
+
                 | keep_rn_syntax                = Just empty_val
                 | otherwise                     = Nothing ;
 
@@ -290,7 +296,6 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
                 tcg_fam_insts      = [],
                 tcg_rules          = [],
                 tcg_fords          = [],
-                tcg_vects          = [],
                 tcg_patsyns        = [],
                 tcg_merged         = [],
                 tcg_dfun_n         = dfun_n_var,
@@ -1349,6 +1354,13 @@ debugTc thing
 ************************************************************************
 -}
 
+addTopEvBinds :: Bag EvBind -> TcM a -> TcM a
+addTopEvBinds new_ev_binds thing_inside
+  =updGblEnv upd_env thing_inside
+  where
+    upd_env tcg_env = tcg_env { tcg_ev_binds = tcg_ev_binds tcg_env
+                                               `unionBags` new_ev_binds }
+
 newTcEvBinds :: TcM EvBindsVar
 newTcEvBinds = do { binds_ref <- newTcRef emptyEvBindMap
                   ; tcvs_ref  <- newTcRef emptyVarSet
@@ -1420,6 +1432,9 @@ emitStaticConstraints static_lie
 
 emitConstraints :: WantedConstraints -> TcM ()
 emitConstraints ct
+  | isEmptyWC ct
+  = return ()
+  | otherwise
   = do { lie_var <- getConstraintVar ;
          updTcRef lie_var (`andWC` ct) }