X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=f105e622c6c0cd4b9bd18aed896d93b09edb2208;hp=6cfbc20fc9855f9bb4b3f8c22d7778b643044edf;hb=4e6bac1ec5a0546584c945c3232863d117496d90;hpb=820ddd55446773b33c797267bcad9e09a621ab2b

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 6cfbc20..f105e62 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -75,7 +75,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
         keep_var     <- newIORef emptyNameSet ;
         used_rdr_var <- newIORef Set.empty ;
 	th_var	     <- newIORef False ;
-	lie_var	     <- newIORef emptyBag ;
+        lie_var      <- newIORef emptyWC ;
 	dfun_n_var   <- newIORef emptyOccSet ;
 	type_env_var <- case hsc_type_env_var hsc_env of {
                            Just (_mod, te_var) -> return te_var ;
@@ -114,11 +114,12 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
 		tcg_warns     = NoWarnings,
 		tcg_anns      = [],
 		tcg_insts     = [],
-		tcg_fam_insts = [],
-		tcg_rules     = [],
-		tcg_fords     = [],
-		tcg_dfun_n    = dfun_n_var,
-		tcg_keep      = keep_var,
+                tcg_fam_insts = [],
+                tcg_rules     = [],
+                tcg_fords     = [],
+                tcg_vects     = [],
+                tcg_dfun_n    = dfun_n_var,
+                tcg_keep      = keep_var,
 		tcg_doc_hdr   = Nothing,
                 tcg_hpc       = False,
                 tcg_main      = Nothing
@@ -147,7 +148,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
 
         -- Check for unsolved constraints
 	lie <- readIORef lie_var ;
-        if isEmptyBag lie 
+        if isEmptyWC lie
            then return ()
            else pprPanic "initTc: unsolved constraints" 
                          (pprWantedsWithLocs lie) ;
@@ -965,17 +966,32 @@ setConstraintVar lie_var = updLclEnv (\ env -> env { tcl_lie = lie_var })
 emitConstraints :: WantedConstraints -> TcM ()
 emitConstraints ct
   = do { lie_var <- getConstraintVar ;
-	 updTcRef lie_var (`andWanteds` ct) }
+         updTcRef lie_var (`andWC` ct) }
 
-emitConstraint :: WantedConstraint -> TcM ()
-emitConstraint ct
+emitFlat :: WantedEvVar -> TcM ()
+emitFlat ct
   = do { lie_var <- getConstraintVar ;
-	 updTcRef lie_var (`extendWanteds` ct) }
+         updTcRef lie_var (`addFlats` unitBag ct) }
+
+emitFlats :: Bag WantedEvVar -> TcM ()
+emitFlats ct
+  = do { lie_var <- getConstraintVar ;
+         updTcRef lie_var (`addFlats` ct) }
+
+emitImplication :: Implication -> TcM ()
+emitImplication ct
+  = do { lie_var <- getConstraintVar ;
+         updTcRef lie_var (`addImplics` unitBag ct) }
+
+emitImplications :: Bag Implication -> TcM ()
+emitImplications ct
+  = do { lie_var <- getConstraintVar ;
+         updTcRef lie_var (`addImplics` ct) }
 
 captureConstraints :: TcM a -> TcM (a, WantedConstraints)
 -- (captureConstraints m) runs m, and returns the type constraints it generates
 captureConstraints thing_inside
-  = do { lie_var <- newTcRef emptyWanteds ;
+  = do { lie_var <- newTcRef emptyWC ;
 	 res <- updLclEnv (\ env -> env { tcl_lie = lie_var }) 
 			  thing_inside ;
 	 lie <- readTcRef lie_var ;
@@ -1136,7 +1152,7 @@ failIfM :: Message -> IfL a
 failIfM msg
   = do 	{ env <- getLclEnv
 	; let full_msg = (if_loc env <> colon) $$ nest 2 msg
-	; liftIO (printErrs (full_msg defaultErrStyle))
+	; liftIO (printErrs full_msg defaultErrStyle)
 	; failM }
 
 --------------------
@@ -1171,7 +1187,7 @@ forkM_maybe doc thing_inside
 	  	    ; return Nothing }
 	}}
   where
-    print_errs sdoc = liftIO (printErrs (sdoc defaultErrStyle))
+    print_errs sdoc = liftIO (printErrs sdoc defaultErrStyle)
 
 forkM :: SDoc -> IfL a -> IfL a
 forkM doc thing_inside