Commit 1c8b3c78 authored by simonpj's avatar simonpj
Browse files

[project @ 2003-10-27 14:08:46 by simonpj]

Fix to super-class loop avoidance code; commented in the file; tcrun020 tests
parent a0908440
...@@ -1529,7 +1529,8 @@ addIrred AddSCs avails irred = ASSERT2( not (irred `elemFM` avails), ppr irred $ ...@@ -1529,7 +1529,8 @@ addIrred AddSCs avails irred = ASSERT2( not (irred `elemFM` avails), ppr irred $
addAvailAndSCs :: Avails -> Inst -> Avail -> TcM Avails addAvailAndSCs :: Avails -> Inst -> Avail -> TcM Avails
addAvailAndSCs avails inst avail addAvailAndSCs avails inst avail
| not (isClassDict inst) = returnM avails1 | not (isClassDict inst) = returnM avails1
| otherwise = addSCs is_loop avails1 inst | otherwise = traceTc (text "addAvailAndSCs" <+> vcat [ppr inst, ppr deps]) `thenM_`
addSCs is_loop avails1 inst
where where
avails1 = addToFM avails inst avail avails1 = addToFM avails inst avail
is_loop inst = inst `elem` deps -- Note: this compares by *type*, not by Unique is_loop inst = inst `elem` deps -- Note: this compares by *type*, not by Unique
...@@ -1562,13 +1563,13 @@ addSCs is_loop avails dict ...@@ -1562,13 +1563,13 @@ addSCs is_loop avails dict
sc_theta' = substTheta (mkTopTyVarSubst tyvars tys) sc_theta sc_theta' = substTheta (mkTopTyVarSubst tyvars tys) sc_theta
add_sc avails (sc_dict, sc_sel) -- Add it, and its superclasses add_sc avails (sc_dict, sc_sel) -- Add it, and its superclasses
| is_loop sc_dict
= returnM avails -- See Note [SUPERCLASS-LOOP]
| otherwise
= case lookupFM avails sc_dict of = case lookupFM avails sc_dict of
Just (Given _ _) -> returnM avails -- Given is cheaper than Just (Given _ _) -> returnM avails -- Given is cheaper than superclass selection
-- a superclass selection Just other -> returnM avails' -- SCs already added
Just other | is_loop sc_dict -> returnM avails -- See Note [SUPERCLASS-LOOP] Nothing -> addSCs is_loop avails' sc_dict
| otherwise -> returnM avails' -- SCs already added
Nothing -> addSCs is_loop avails' sc_dict
where where
sc_sel_rhs = DictApp (TyApp (HsVar sc_sel) tys) [instToId dict] sc_sel_rhs = DictApp (TyApp (HsVar sc_sel) tys) [instToId dict]
avail = Rhs sc_sel_rhs [dict] avail = Rhs sc_sel_rhs [dict]
...@@ -1588,6 +1589,14 @@ superclasses of C [a] to avails. But we must not overwrite the binding ...@@ -1588,6 +1589,14 @@ superclasses of C [a] to avails. But we must not overwrite the binding
for d1:Ord a (which is given) with a superclass selection or we'll just for d1:Ord a (which is given) with a superclass selection or we'll just
build a loop! build a loop!
Here's another variant, immortalised in tcrun020
class Monad m => C1 m
class C1 m => C2 m x
instance C2 Maybe Bool
For the instance decl we need to build (C1 Maybe), and it's no good if
we run around and add (C2 Maybe Bool) and its superclasses to the avails
before we search for C1 Maybe.
Here's another example Here's another example
class Eq b => Foo a b class Eq b => Foo a b
instance Eq a => Foo [a] a instance Eq a => Foo [a] a
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment