Fix an egregious bug: INLINE pragmas on monomorphic Ids were being ignored

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

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 546d96e..0e7acdd 100644 (file)
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -236,7 +236,7 @@ simplifyAsMuchAsPossible ctxt wanteds
               simplifyApproxLoop 0 wanteds
 
              -- Report any errors
-       ; mapBagM_ reportUnsolvedImplication unsolved_implics
+       ; reportUnsolved (emptyBag, unsolved_implics)
 
        ; let final_wanted_evvars = mapBag deCanonicaliseWanted unsolved_flats
        ; return (final_wanted_evvars, ev_binds) }
@@ -676,7 +676,7 @@ floatEqualities :: TcTyVarSet -> [EvVar]
                 -> CanonicalCts -> (CanonicalCts, CanonicalCts)
 floatEqualities skols can_given wanteds
   | hasEqualities can_given = (emptyBag, wanteds)
-  | otherwise                 = partitionBag is_floatable wanteds
+  | otherwise               = partitionBag is_floatable wanteds
   where
     is_floatable :: CanonicalCt -> Bool
     is_floatable (CTyEqCan { cc_tyvar = tv, cc_rhs = ty })
@@ -787,7 +787,8 @@ defaultTyVar untch the_tv
   , not (the_tv `elemVarSet` untch)
   , not (k `eqKind` default_k)
   = do { (ev, better_ty) <- TcSMonad.newKindConstraint (mkTyVarTy the_tv) default_k
-       ; let loc = CtLoc TypeEqOrigin (getSrcSpan the_tv) [] -- Yuk
+       ; let loc = CtLoc DefaultOrigin (getSrcSpan the_tv) [] -- Yuk
+                          -- 'DefaultOrigin' is strictly the declaration, but it's convenient
              wanted_eq  = CTyEqCan { cc_id     = ev
                                    , cc_flavor = Wanted loc
                                    , cc_tyvar  = the_tv
@@ -816,7 +817,7 @@ findDefaultableGroups (ctxt, default_tys, (ovl_strings, extended_defaults))
   | otherwise = filter is_defaultable_group (equivClasses cmp_tv unaries)
   where 
     unaries     :: [(CanonicalCt, TcTyVar)]  -- (C tv) constraints
-    non_unaries :: [CanonicalCt]             -- *other* constraints
+    non_unaries :: [CanonicalCt]             -- and *other* constraints
     
     (unaries, non_unaries) = partitionWith find_unary (bagToList wanteds)
         -- Finds unary type-class constraints