Here it is, only 40 lines.
Probably, it can be reduced further, but i hope, this would suffice.
Hugs-98-March-99 (started by ..hugs -98 +o -h2200K ...)
gives the wrong result s==s' -> False
for the enclosed program.
Since upAu is obtained as substitution a <-- u into upA,
s should equal s' in the result. And it does not.
There are overlapping Set instances for (R a), (R P)
- see the lines between `-- **'.
Commenting out any of them hides the bug.
The impression is that Hugs chooses the first instance for s and
the second for s'.
------------------
Sergey Mechveliani
[EMAIL PROTECTED]
----------------------------------------------------------------------
module B (b)
where
b = let u = R P
upSg a = case bSet a [] of (d',_) -> fst (bASmg a d')
upA a = case upSg a of t -> fst (bAGroup a t)
upAu = case upSg u of t -> fst (bAGroup u t)
Just (D1S s ) = lookup Set (upA u)
Just (D1S s') = lookup Set upAu
in
s==s'
----------------------------------------------------------------------
data P = P
data R a = R a
data Name = Set | ASmg | AGroup deriving(Eq)
data Dom1 a = D1S Bool | D1Sm Bool | D1G Bool deriving(Show)
type Doms1 a = [(Name, Dom1 a)]
class Set a where bSet :: a -> Doms1 a -> (Doms1 a, Bool)
class (Set a ) => ASmg a where bASmg :: a->Doms1 a->(Doms1 a,Bool)
class (ASmg a) => AGroup a where bAGroup :: a->Doms1 a->(Doms1 a,Bool)
upASmg :: (ASmg a) => a -> Doms1 a -> Doms1 a
upASmg a = fst .bASmg a .fst .bSet a
upAG :: AGroup a => a -> Doms1 a -> Doms1 a
upAG a = fst . bAGroup a . upASmg a
instance Set P
instance ASmg P where bASmg _ d = (d,True)
instance AGroup P
-- **
instance Set (R a) where bSet _ d = ((Set,D1S False):d, False)
instance ASmg (R a) where bASmg _ d = (d,True)
instance AGroup (R a) where bAGroup _ d = (d,True)
instance Set (R P) where bSet _ d = ((Set,D1S True):d, True)
instance ASmg (R P) where bASmg _ d = (d,True)
-- **
