Skip to content
Snippets Groups Projects
Commit f6d9b940 authored by Jeff Lewis's avatar Jeff Lewis
Browse files

[project @ 2000-07-14 23:54:06 by lewie]

Functional Dependencies were not getting simplified away when the dictionary
that generated them was simplified by instance resolution.  Fixed.
parent f062b59e
No related merge requests found
......@@ -451,12 +451,15 @@ newOverloadedLit orig lit ty -- The general case
\begin{code}
newFunDepFromDict dict
| isClassDict dict
= tcGetUnique `thenNF_Tc` \ uniq ->
let (clas, tys) = getDictClassTys dict
fds = instantiateFdClassTys clas tys
inst = FunDep uniq clas fds (instLoc dict)
in
if null fds then returnNF_Tc Nothing else returnNF_Tc (Just inst)
| otherwise
= returnNF_Tc Nothing
\end{code}
\begin{code}
......
......@@ -709,7 +709,7 @@ activate avails wanted
addWanted avails wanted rhs_expr
= ASSERT( not (wanted `elemFM` avails) )
returnNF_Tc (addToFM avails wanted avail)
addFunDeps (addToFM avails wanted avail) wanted
-- NB: we don't add the thing's superclasses too!
-- Why not? Because addWanted is used when we've successfully used an
-- instance decl to reduce something; e.g.
......@@ -772,7 +772,6 @@ addAvail avails wanted avail
addSuperClasses :: Avails s -> Inst -> NF_TcM s (Avails s)
-- Add all the superclasses of the Inst to Avails
-- JRL - also add in the functional dependencies
-- Invariant: the Inst is already in Avails.
addSuperClasses avails dict
......@@ -781,12 +780,7 @@ addSuperClasses avails dict
| otherwise -- It is a dictionary
= foldlNF_Tc add_sc avails (zipEqual "addSuperClasses" sc_theta' sc_sels) `thenNF_Tc` \ avails' ->
newFunDepFromDict dict `thenNF_Tc` \ fdInst_maybe ->
case fdInst_maybe of
Nothing -> returnNF_Tc avails'
Just fdInst ->
let fdAvail = Avail (instToId (fromJust fdInst_maybe)) NoRhs [] in
addAvail avails fdInst fdAvail
addFunDeps avails' dict
where
(clas, tys) = getDictClassTys dict
(tyvars, sc_theta, sc_sels, _) = classBigSig clas
......@@ -821,6 +815,16 @@ addSuperClasses avails dict
avail = Avail (instToId super_dict)
(PassiveScSel sc_sel_rhs [dict])
[]
addFunDeps :: Avails s -> Inst -> NF_TcM s (Avails s)
-- Add in the functional dependencies generated by the inst
addFunDeps avails inst
= newFunDepFromDict inst `thenNF_Tc` \ fdInst_maybe ->
case fdInst_maybe of
Nothing -> returnNF_Tc avails
Just fdInst ->
let fdAvail = Avail (instToId (fromJust fdInst_maybe)) NoRhs [] in
addAvail avails fdInst fdAvail
\end{code}
%************************************************************************
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment