Fix signatures w/ implicit parameter types in them (in particular,
correctly handle the case where there are no type variables). Also
made a few more things Outputable. Nuke outdated comment in Parser.y.
{-
-----------------------------------------------------------------------------
{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.25 2000/02/28 09:17:54 simonmar Exp $
+$Id: Parser.y,v 1.26 2000/02/28 21:59:32 lewie Exp $
-----------------------------------------------------------------------------
Conflicts: 14 shift/reduce
(note: it's currently 21 -- JRL, 31/1/2000)
-----------------------------------------------------------------------------
Conflicts: 14 shift/reduce
(note: it's currently 21 -- JRL, 31/1/2000)
- (note2: it's currently 36, but not because of me -- SUP, 15/2/2000 :-)
8 for abiguity in 'if x then y else z + 1'
(shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
8 for abiguity in 'if x then y else z + 1'
(shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
SrcLoc -- Of the signature
SrcLoc -- Of the signature
+instance Outputable TcSigInfo where
+ ppr (TySigInfo nm id tyvars theta tau _ inst loc) =
+ ppr nm <+> ptext SLIT("::") <+> ppr tyvars <+> ppr theta <+> ptext SLIT("=>") <+> ppr tau
maybeSig :: [TcSigInfo] -> Name -> Maybe (TcSigInfo)
-- Search for a particular signature
maybeSig :: [TcSigInfo] -> Name -> Maybe (TcSigInfo)
-- Search for a particular signature
LIE) -- Remaining wanteds; no dups
tcSimplify str local_tvs wanted_lie
LIE) -- Remaining wanteds; no dups
tcSimplify str local_tvs wanted_lie
+{- this is just an optimization, and interferes with implicit params,
+ disable it for now. same goes for tcSimplifyAndCheck
| isEmptyVarSet local_tvs
= returnTc (wanted_lie, EmptyMonoBinds, emptyLIE)
| isEmptyVarSet local_tvs
= returnTc (wanted_lie, EmptyMonoBinds, emptyLIE)
TcDictBinds) -- Bindings
tcSimplifyAndCheck str local_tvs given_lie wanted_lie
TcDictBinds) -- Bindings
tcSimplifyAndCheck str local_tvs given_lie wanted_lie
| isEmptyVarSet local_tvs
-- This can happen quite legitimately; for example in
-- instance Num Int where ...
= returnTc (wanted_lie, EmptyMonoBinds)
| otherwise
| isEmptyVarSet local_tvs
-- This can happen quite legitimately; for example in
-- instance Num Int where ...
= returnTc (wanted_lie, EmptyMonoBinds)
| otherwise
= reduceContext str try_me givens wanteds `thenTc` \ (binds, frees, irreds) ->
-- Complain about any irreducible ones
= reduceContext str try_me givens wanteds `thenTc` \ (binds, frees, irreds) ->
-- Complain about any irreducible ones
try_me inst
-- Does not constrain a local tyvar
| isEmptyVarSet (tyVarsOfInst inst `intersectVarSet` local_tvs)
try_me inst
-- Does not constrain a local tyvar
| isEmptyVarSet (tyVarsOfInst inst `intersectVarSet` local_tvs)
+ && (isDict inst || null (getIPs inst))
= Free
-- When checking against a given signature we always reduce
= Free
-- When checking against a given signature we always reduce
pprAvails avails = vcat (map pprAvail (eltsFM avails))
pprAvails avails = vcat (map pprAvail (eltsFM avails))
pprAvail (Avail main_id rhs ids)
= ppr main_id <> colon <+> brackets (ppr ids) <+> pprRhs rhs
pprAvail (Avail main_id rhs ids)
= ppr main_id <> colon <+> brackets (ppr ids) <+> pprRhs rhs
+instance Outputable Avail where
+ ppr = pprAvail
+
pprRhs NoRhs = text "<no rhs>"
pprRhs (Rhs rhs b) = ppr rhs
pprRhs (PassiveScSel rhs is) = text "passive" <+> ppr rhs
pprRhs NoRhs = text "<no rhs>"
pprRhs (Rhs rhs b) = ppr rhs
pprRhs (PassiveScSel rhs is) = text "passive" <+> ppr rhs
text "wanted" <+> ppr wanteds,
text "----",
text "avails" <+> pprAvails avails,
text "wanted" <+> ppr wanteds,
text "----",
text "avails" <+> pprAvails avails,
+ text "frees" <+> ppr frees,
text "irreds" <+> ppr irreds,
text "----------------------"
]) $
text "irreds" <+> ppr irreds,
text "----------------------"
]) $
= parens (hcat [pprX fm_l, space,
ppr key, space, int (IF_GHC(I# sz, sz)), space,
pprX fm_r])
= parens (hcat [pprX fm_l, space,
ppr key, space, int (IF_GHC(I# sz, sz)), space,
pprX fm_r])
+#else
+-- and when not debugging the package itself...
+instance (Outputable key, Outputable elt) => Outputable (FiniteMap key elt) where
+ ppr fm = ppr (fmToList fm)